/-
Copyright (c) 2018 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro
-/
import data.list.count
import data.list.lex
import logic.pairwise
import logic.relation

/-!
# Pairwise relations on a list

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

This file provides basic results about `list.pairwise` and `list.pw_filter` (definitions are in
`data.list.defs`).
`pairwise r [a 0, ..., a (n - 1)]` means `∀ i j, i < j → r (a i) (a j)`. For example,
`pairwise (≠) l` means that all elements of `l` are distinct, and `pairwise (<) l` means that `l`
is strictly increasing.
`pw_filter r l` is the list obtained by iteratively adding each element of `l` that doesn't break
the pairwiseness of the list we have so far. It thus yields `l'` a maximal sublist of `l` such that
`pairwise r l'`.

## Tags

sorted, nodup
-/

open nat function

namespace list
variables {α β : Type*} {R S T: α → α → Prop} {a : α} {l : list α}

mk_iff_of_inductive_prop list.pairwise list.pairwise_iff

/-! ### Pairwise -/

lemma rel_of_pairwise_cons (p : (a :: l).pairwise R) : ∀ {a'}, a' ∈ l → R a a' :=
(pairwise_cons.1 p).1

lemma pairwise.of_cons (p : (a :: l).pairwise R) : pairwise R l := (pairwise_cons.1 p).2

theorem pairwise.tail : ∀ {l : list α} (p : pairwise R l), pairwise R l.tail
| [] h := h
| (a :: l) h := h.of_cons

theorem pairwise.drop : ∀ {l : list α} {n : ℕ}, list.pairwise R l → list.pairwise R (l.drop n)
| _ 0 h := h
| [] (n + 1) h := list.pairwise.nil
| (a :: l) (n + 1) h := pairwise.drop (pairwise_cons.mp h).right

theorem pairwise.imp_of_mem {S : α → α → Prop} {l : list α}
  (H : ∀ {a b}, a ∈ l → b ∈ l → R a b → S a b) (p : pairwise R l) : pairwise S l :=
begin
  induction p with a l r p IH generalizing H; constructor,
  { exact ball.imp_right
      (λ x h, H (mem_cons_self _ _) (mem_cons_of_mem _ h)) r },
  { exact IH (λ a b m m', H
      (mem_cons_of_mem _ m) (mem_cons_of_mem _ m')) }
end

lemma pairwise.imp (H : ∀ a b, R a b → S a b) : pairwise R l → pairwise S l :=
pairwise.imp_of_mem (λ a b _ _, H a b)

lemma pairwise_and_iff : l.pairwise (λ a b, R a b ∧ S a b) ↔ l.pairwise R ∧ l.pairwise S :=
⟨λ h, ⟨h.imp (λ a b h, h.1), h.imp (λ a b h, h.2)⟩,
 λ ⟨hR, hS⟩, begin
  clear_, induction hR with a l R1 R2 IH;
  simp only [pairwise.nil, pairwise_cons] at *,
  exact ⟨λ b bl, ⟨R1 b bl, hS.1 b bl⟩, IH hS.2⟩
 end⟩

lemma pairwise.and (hR : l.pairwise R) (hS : l.pairwise S) : l.pairwise (λ a b, R a b ∧ S a b) :=
pairwise_and_iff.2 ⟨hR, hS⟩

lemma pairwise.imp₂ (H : ∀ a b, R a b → S a b → T a b) (hR : l.pairwise R) (hS : l.pairwise S) :
  l.pairwise T :=
(hR.and hS).imp $ λ a b, and.rec (H a b)

theorem pairwise.iff_of_mem {S : α → α → Prop} {l : list α}
  (H : ∀ {a b}, a ∈ l → b ∈ l → (R a b ↔ S a b)) : pairwise R l ↔ pairwise S l :=
⟨pairwise.imp_of_mem (λ a b m m', (H m m').1),
 pairwise.imp_of_mem (λ a b m m', (H m m').2)⟩

theorem pairwise.iff {S : α → α → Prop}
  (H : ∀ a b, R a b ↔ S a b) {l : list α} : pairwise R l ↔ pairwise S l :=
pairwise.iff_of_mem (λ a b _ _, H a b)

theorem pairwise_of_forall {l : list α} (H : ∀ x y, R x y) : pairwise R l :=
by induction l; [exact pairwise.nil,
simp only [*, pairwise_cons, forall_2_true_iff, and_true]]

theorem pairwise.and_mem {l : list α} :
  pairwise R l ↔ pairwise (λ x y, x ∈ l ∧ y ∈ l ∧ R x y) l :=
pairwise.iff_of_mem (by simp only [true_and, iff_self, forall_2_true_iff] {contextual := tt})

theorem pairwise.imp_mem {l : list α} :
  pairwise R l ↔ pairwise (λ x y, x ∈ l → y ∈ l → R x y) l :=
pairwise.iff_of_mem
  (by simp only [forall_prop_of_true, iff_self, forall_2_true_iff] {contextual := tt})

protected lemma pairwise.sublist : Π {l₁ l₂ : list α}, l₁ <+ l₂ → pairwise R l₂ → pairwise R l₁
| ._ ._ sublist.slnil h := h
| ._ ._ (sublist.cons l₁ l₂ a s) (pairwise.cons i h) := h.sublist s
| ._ ._ (sublist.cons2 l₁ l₂ a s) (pairwise.cons i h) :=
  (h.sublist s).cons (ball.imp_left s.subset i)

lemma pairwise.forall_of_forall_of_flip (h₁ : ∀ x ∈ l, R x x) (h₂ : l.pairwise R)
  (h₃ : l.pairwise (flip R)) :
  ∀ ⦃x⦄, x ∈ l → ∀ ⦃y⦄, y ∈ l → R x y :=
begin
  induction l with a l ih,
  { exact forall_mem_nil _ },
  rw pairwise_cons at h₂ h₃,
  rintro x (rfl | hx) y (rfl | hy),
  { exact h₁ _ (l.mem_cons_self _) },
  { exact h₂.1 _ hy },
  { exact h₃.1 _ hx },
  { exact ih (λ x hx, h₁ _ $ mem_cons_of_mem _ hx) h₂.2 h₃.2 hx hy }
end

lemma pairwise.forall_of_forall (H : symmetric R) (H₁ : ∀ x ∈ l, R x x) (H₂ : l.pairwise R) :
  ∀ ⦃x⦄, x ∈ l → ∀ ⦃y⦄, y ∈ l → R x y :=
H₂.forall_of_forall_of_flip H₁ $ by rwa H.flip_eq

lemma pairwise.forall (hR : symmetric R) (hl : l.pairwise R) :
  ∀ ⦃a⦄, a ∈ l → ∀ ⦃b⦄, b ∈ l → a ≠ b → R a b :=
pairwise.forall_of_forall
  (λ a b h hne, hR (h hne.symm))
  (λ _ _ h, (h rfl).elim)
  (hl.imp $ λ _ _ h _, h)

lemma pairwise.set_pairwise (hl : pairwise R l) (hr : symmetric R) : {x | x ∈ l}.pairwise R :=
hl.forall hr

theorem pairwise_singleton (R) (a : α) : pairwise R [a] :=
by simp only [pairwise_cons, mem_singleton, forall_prop_of_false (not_mem_nil _), forall_true_iff,
  pairwise.nil, and_true]

theorem pairwise_pair {a b : α} : pairwise R [a, b] ↔ R a b :=
by simp only [pairwise_cons, mem_singleton, forall_eq, forall_prop_of_false (not_mem_nil _),
  forall_true_iff, pairwise.nil, and_true]

theorem pairwise_append {l₁ l₂ : list α} : pairwise R (l₁++l₂) ↔
  pairwise R l₁ ∧ pairwise R l₂ ∧ ∀ x ∈ l₁, ∀ y ∈ l₂, R x y :=
by induction l₁ with x l₁ IH; [simp only [list.pairwise.nil, forall_prop_of_false (not_mem_nil _),
  forall_true_iff, and_true, true_and, nil_append],
simp only [cons_append, pairwise_cons, forall_mem_append, IH, forall_mem_cons, forall_and_distrib,
  and_assoc, and.left_comm]]

theorem pairwise_append_comm (s : symmetric R) {l₁ l₂ : list α} :
  pairwise R (l₁++l₂) ↔ pairwise R (l₂++l₁) :=
have ∀ l₁ l₂ : list α,
  (∀ (x : α), x ∈ l₁ → ∀ (y : α), y ∈ l₂ → R x y) →
  (∀ (x : α), x ∈ l₂ → ∀ (y : α), y ∈ l₁ → R x y),
from λ l₁ l₂ a x xm y ym, s (a y ym x xm),
by simp only [pairwise_append, and.left_comm]; rw iff.intro (this l₁ l₂) (this l₂ l₁)

theorem pairwise_middle (s : symmetric R) {a : α} {l₁ l₂ : list α} :
  pairwise R (l₁ ++ a :: l₂) ↔ pairwise R (a :: (l₁++l₂)) :=
show pairwise R (l₁ ++ ([a] ++ l₂)) ↔ pairwise R ([a] ++ l₁ ++ l₂),
by rw [← append_assoc, pairwise_append, @pairwise_append _ _ ([a] ++ l₁), pairwise_append_comm s];
   simp only [mem_append, or_comm]

theorem pairwise_map (f : β → α) :
  ∀ {l : list β}, pairwise R (map f l) ↔ pairwise (λ a b : β, R (f a) (f b)) l
| []     := by simp only [map, pairwise.nil]
| (b :: l) :=
  have (∀ a b', b' ∈ l → f b' = a → R (f b) a) ↔ ∀ (b' : β), b' ∈ l → R (f b) (f b'), from
  forall_swap.trans $ forall_congr $ λ a, forall_swap.trans $ by simp only [forall_eq'],
  by simp only [map, pairwise_cons, mem_map, exists_imp_distrib, and_imp, this, pairwise_map]

lemma pairwise.of_map {S : β → β → Prop} (f : α → β) (H : ∀ a b : α, S (f a) (f b) → R a b)
  (p : pairwise S (map f l)) : pairwise R l :=
((pairwise_map f).1 p).imp H

lemma pairwise.map {S : β → β → Prop} (f : α → β) (H : ∀ a b : α, R a b → S (f a) (f b))
  (p : pairwise R l) : pairwise S (map f l) :=
(pairwise_map f).2 $ p.imp H

theorem pairwise_filter_map (f : β → option α) {l : list β} :
  pairwise R (filter_map f l) ↔ pairwise (λ a a' : β, ∀ (b ∈ f a) (b' ∈ f a'), R b b') l :=
let S (a a' : β) := ∀ (b ∈ f a) (b' ∈ f a'), R b b' in
begin
  simp only [option.mem_def], induction l with a l IH,
  { simp only [filter_map, pairwise.nil] },
  cases e : f a with b,
  { rw [filter_map_cons_none _ _ e, IH, pairwise_cons],
    simp only [e, forall_prop_of_false not_false, forall_3_true_iff, true_and] },
  rw [filter_map_cons_some _ _ _ e],
  simp only [pairwise_cons, mem_filter_map, exists_imp_distrib, and_imp, IH, e, forall_eq'],
  show (∀ (a' : α) (x : β), x ∈ l → f x = some a' → R b a') ∧ pairwise S l ↔
        (∀ (a' : β), a' ∈ l → ∀ (b' : α), f a' = some b' → R b b') ∧ pairwise S l,
  from and_congr ⟨λ h b mb a ma, h a b mb ma, λ h a b mb ma, h b mb a ma⟩ iff.rfl
end

theorem pairwise.filter_map {S : β → β → Prop} (f : α → option β)
  (H : ∀ (a a' : α), R a a' → ∀ (b ∈ f a) (b' ∈ f a'), S b b') {l : list α}
  (p : pairwise R l) : pairwise S (filter_map f l) :=
(pairwise_filter_map _).2 $ p.imp H

theorem pairwise_filter (p : α → Prop) [decidable_pred p] {l : list α} :
  pairwise R (filter p l) ↔ pairwise (λ x y, p x → p y → R x y) l :=
begin
  rw [← filter_map_eq_filter, pairwise_filter_map],
  apply pairwise.iff, intros, simp only [option.mem_def, option.guard_eq_some, and_imp, forall_eq'],
end

lemma pairwise.filter (p : α → Prop) [decidable_pred p] : pairwise R l → pairwise R (filter p l) :=
pairwise.sublist (filter_sublist _)

theorem pairwise_pmap {p : β → Prop} {f : Π b, p b → α} {l : list β} (h : ∀ x ∈ l, p x) :
  pairwise R (l.pmap f h) ↔
    pairwise (λ b₁ b₂, ∀ (h₁ : p b₁) (h₂ : p b₂), R (f b₁ h₁) (f b₂ h₂)) l :=
begin
  induction l with a l ihl, { simp },
  obtain ⟨ha, hl⟩ : p a ∧ ∀ b, b ∈ l → p b, by simpa using h,
  simp only [ihl hl, pairwise_cons, bex_imp_distrib, pmap, and.congr_left_iff, mem_pmap],
  refine λ _, ⟨λ H b hb hpa hpb, H _ _ hb rfl, _⟩,
  rintro H _ b hb rfl,
  exact H b hb _ _
end

theorem pairwise_join {L : list (list α)} : pairwise R (join L) ↔
  (∀ l ∈ L, pairwise R l) ∧ pairwise (λ l₁ l₂, ∀ (x ∈ l₁) (y ∈ l₂), R x y) L :=
begin
  induction L with l L IH,
  {simp only [join, pairwise.nil, forall_prop_of_false (not_mem_nil _), forall_const, and_self]},
  have : (∀ (x : α), x ∈ l → ∀ (y : α) (x_1 : list α), x_1 ∈ L → y ∈ x_1 → R x y) ↔
          ∀ (a' : list α), a' ∈ L → ∀ (x : α), x ∈ l → ∀ (y : α), y ∈ a' → R x y :=
    ⟨λ h a b c d e, h c d e a b, λ h c d e a b, h a b c d e⟩,
  simp only [join, pairwise_append, IH, mem_join, exists_imp_distrib, and_imp, this,
    forall_mem_cons, pairwise_cons],
  simp only [and_assoc, and_comm, and.left_comm],
end

lemma pairwise_bind {R : β → β → Prop} {l : list α} {f : α → list β} :
  list.pairwise R (l.bind f) ↔
    (∀ a ∈ l, pairwise R (f a)) ∧ pairwise (λ a₁ a₂, ∀ (x ∈ f a₁) (y ∈ f a₂), R x y) l :=
by simp [list.bind, list.pairwise_join, list.mem_map, list.pairwise_map]

@[simp] theorem pairwise_reverse : ∀ {R} {l : list α},
  pairwise R (reverse l) ↔ pairwise (λ x y, R y x) l :=
suffices ∀ {R l}, @pairwise α R l → pairwise (λ x y, R y x) (reverse l),
from λ R l, ⟨λ p, reverse_reverse l ▸ this p, this⟩,
λ R l p, by induction p with a l h p IH;
  [apply pairwise.nil, simpa only [reverse_cons, pairwise_append, IH,
    pairwise_cons, forall_prop_of_false (not_mem_nil _), forall_true_iff,
    pairwise.nil, mem_reverse, mem_singleton, forall_eq, true_and] using h]

lemma pairwise_of_reflexive_on_dupl_of_forall_ne [decidable_eq α] {l : list α} {r : α → α → Prop}
  (hr : ∀ a, 1 < count a l → r a a)
  (h : ∀ (a ∈ l) (b ∈ l), a ≠ b → r a b) : l.pairwise r :=
begin
  induction l with hd tl IH,
  { simp },
  { rw list.pairwise_cons,
    split,
    { intros x hx,
      by_cases H : hd = x,
      { rw H,
        refine hr _ _,
        simpa [count_cons, H, nat.succ_lt_succ_iff, count_pos] using hx },
      { exact h hd (mem_cons_self _ _) x (mem_cons_of_mem _ hx) H } },
    { refine IH _ _,
      { intros x hx,
        refine hr _ _,
        rw count_cons,
        split_ifs,
        { exact hx.trans (nat.lt_succ_self _) },
        { exact hx } },
      { intros x hx y hy,
        exact h x (mem_cons_of_mem _ hx) y (mem_cons_of_mem _ hy) } } }
end

lemma pairwise_of_forall_mem_list {l : list α} {r : α → α → Prop} (h : ∀ (a ∈ l) (b ∈ l), r a b) :
  l.pairwise r :=
begin
  classical,
  refine pairwise_of_reflexive_on_dupl_of_forall_ne (λ a ha', _) (λ a ha b hb _, h a ha b hb),
  have ha := list.one_le_count_iff_mem.1 ha'.le,
  exact h a ha a ha
end

lemma pairwise_of_reflexive_of_forall_ne {l : list α} {r : α → α → Prop}
  (hr : reflexive r) (h : ∀ (a ∈ l) (b ∈ l), a ≠ b → r a b) : l.pairwise r :=
by { classical, exact pairwise_of_reflexive_on_dupl_of_forall_ne (λ _ _, hr _) h }

theorem pairwise_iff_nth_le {R} : ∀ {l : list α},
  pairwise R l ↔ ∀ i j (h₁ : j < length l) (h₂ : i < j),
    R (nth_le l i (lt_trans h₂ h₁)) (nth_le l j h₁)
| [] := by simp only [pairwise.nil, true_iff]; exact λ i j h, (nat.not_lt_zero j).elim h
| (a :: l) := begin
  rw [pairwise_cons, pairwise_iff_nth_le],
  refine ⟨λ H i j h₁ h₂, _, λ H, ⟨λ a' m, _,
    λ i j h₁ h₂, H _ _ (succ_lt_succ h₁) (succ_lt_succ h₂)⟩⟩,
  { cases j with j, {exact (nat.not_lt_zero _).elim h₂},
    cases i with i,
    { exact H.1 _ (nth_le_mem l _ _) },
    { exact H.2 _ _ (lt_of_succ_lt_succ h₁) (lt_of_succ_lt_succ h₂) } },
  { rcases nth_le_of_mem m with ⟨n, h, rfl⟩,
    exact H _ _ (succ_lt_succ h) (succ_pos _) }
end

lemma pairwise_replicate {α : Type*} {r : α → α → Prop} {x : α} (hx : r x x) :
  ∀ (n : ℕ), pairwise r (replicate n x)
| 0 := by simp
| (n+1) := by simp [hx, mem_replicate, pairwise_replicate n]

/-! ### Pairwise filtering -/

variable [decidable_rel R]

@[simp] theorem pw_filter_nil : pw_filter R [] = [] := rfl

@[simp] theorem pw_filter_cons_of_pos {a : α} {l : list α} (h : ∀ b ∈ pw_filter R l, R a b) :
  pw_filter R (a :: l) = a :: pw_filter R l := if_pos h

@[simp] theorem pw_filter_cons_of_neg {a : α} {l : list α} (h : ¬ ∀ b ∈ pw_filter R l, R a b) :
  pw_filter R (a :: l) = pw_filter R l := if_neg h

theorem pw_filter_map (f : β → α) :
  Π (l : list β), pw_filter R (map f l) = map f (pw_filter (λ x y, R (f x) (f y)) l)
| [] := rfl
| (x :: xs) :=
  if h : ∀ b ∈ pw_filter R (map f xs), R (f x) b
    then have h' : ∀ (b : β), b ∈ pw_filter (λ (x y : β), R (f x) (f y)) xs → R (f x) (f b),
           from λ b hb, h _ (by rw [pw_filter_map]; apply mem_map_of_mem _ hb),
         by rw [map,pw_filter_cons_of_pos h,pw_filter_cons_of_pos h',pw_filter_map,map]
    else have h' : ¬∀ (b : β), b ∈ pw_filter (λ (x y : β), R (f x) (f y)) xs → R (f x) (f b),
           from λ hh, h $ λ a ha,
           by { rw [pw_filter_map,mem_map] at ha, rcases ha with ⟨b,hb₀,hb₁⟩,
                subst a, exact hh _ hb₀, },
         by rw [map,pw_filter_cons_of_neg h,pw_filter_cons_of_neg h',pw_filter_map]

theorem pw_filter_sublist : ∀ (l : list α), pw_filter R l <+ l
| []     := nil_sublist _
| (x :: l) := begin
  by_cases (∀ y ∈ pw_filter R l, R x y),
  { rw [pw_filter_cons_of_pos h],
    exact (pw_filter_sublist l).cons_cons _ },
  { rw [pw_filter_cons_of_neg h],
    exact sublist_cons_of_sublist _ (pw_filter_sublist l) },
end

theorem pw_filter_subset (l : list α) : pw_filter R l ⊆ l :=
(pw_filter_sublist _).subset

theorem pairwise_pw_filter : ∀ (l : list α), pairwise R (pw_filter R l)
| []     := pairwise.nil
| (x :: l) := begin
  by_cases (∀ y ∈ pw_filter R l, R x y),
  { rw [pw_filter_cons_of_pos h],
    exact pairwise_cons.2 ⟨h, pairwise_pw_filter l⟩ },
  { rw [pw_filter_cons_of_neg h],
    exact pairwise_pw_filter l },
end

theorem pw_filter_eq_self {l : list α} : pw_filter R l = l ↔ pairwise R l :=
⟨λ e, e ▸ pairwise_pw_filter l, λ p, begin
  induction l with x l IH, {refl},
  cases pairwise_cons.1 p with al p,
  rw [pw_filter_cons_of_pos (ball.imp_left (pw_filter_subset l) al), IH p],
end⟩

alias pw_filter_eq_self ↔ _ pairwise.pw_filter

attribute [protected] pairwise.pw_filter

@[simp] lemma pw_filter_idempotent : pw_filter R (pw_filter R l) = pw_filter R l :=
(pairwise_pw_filter l).pw_filter

theorem forall_mem_pw_filter (neg_trans : ∀ {x y z}, R x z → R x y ∨ R y z)
  (a : α) (l : list α) : (∀ b ∈ pw_filter R l, R a b) ↔ (∀ b ∈ l, R a b) :=
⟨begin
  induction l with x l IH, { exact λ _ _, false.elim },
  simp only [forall_mem_cons],
  by_cases (∀ y ∈ pw_filter R l, R x y); dsimp at h,
  { simp only [pw_filter_cons_of_pos h, forall_mem_cons, and_imp],
    exact λ r H, ⟨r, IH H⟩ },
  { rw [pw_filter_cons_of_neg h],
    refine λ H, ⟨_, IH H⟩,
    cases e : find (λ y, ¬ R x y) (pw_filter R l) with k,
    { refine h.elim (ball.imp_right _ (find_eq_none.1 e)),
      exact λ y _, not_not.1 },
    { have := find_some e,
      exact (neg_trans (H k (find_mem e))).resolve_right this } }
end, ball.imp_left (pw_filter_subset l)⟩

end list


/-
Copyright (c) 2019 Amelia Livingston. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Amelia Livingston, Jireh Loreaux
Ported by: Winston Yin

! This file was ported from Lean 3 source module algebra.hom.ring
! leanprover-community/mathlib commit cf9386b56953fb40904843af98b7a80757bbe7f9
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Algebra.GroupWithZero.InjSurj
import Mathlib.Algebra.Ring.Basic
import Mathlib.Algebra.Divisibility.Basic
import Mathlib.Data.Pi.Algebra
import Mathlib.Algebra.Hom.Units
import Mathlib.Data.Set.Image

/-!
# Homomorphisms of semirings and rings

This file defines bundled homomorphisms of (non-unital) semirings and rings. As with monoid and
groups, we use the same structure `RingHom a β`, a.k.a. `α →+* β`, for both types of homomorphisms.

## Main definitions

* `NonUnitalRingHom`: Non-unital (semi)ring homomorphisms. Additive monoid homomorphism which
  preserve multiplication.
* `RingHom`: (Semi)ring homomorphisms. Monoid homomorphisms which are also additive monoid
  homomorphism.

## Notations

* `→ₙ+*`: Non-unital (semi)ring homs
* `→+*`: (Semi)ring homs

## Implementation notes

* There's a coercion from bundled homs to fun, and the canonical notation is to
  use the bundled hom as a function via this coercion.

* There is no `SemiringHom` -- the idea is that `RingHom` is used.
  The constructor for a `RingHom` between semirings needs a proof of `map_zero`,
  `map_one` and `map_add` as well as `map_mul`; a separate constructor
  `RingHom.mk'` will construct ring homs between rings from monoid homs given
  only a proof that addition is preserved.

## Tags

`RingHom`, `SemiringHom`
-/

open Function

variable {F α β γ : Type _}

/-- Bundled non-unital semiring homomorphisms `α →ₙ+* β`; use this for bundled non-unital ring
homomorphisms too.

When possible, instead of parametrizing results over `(f : α →ₙ+* β)`,
you should parametrize over `(F : Type _) [NonUnitalRingHomClass F α β] (f : F)`.

When you extend this structure, make sure to extend `NonUnitalRingHomClass`. -/
structure NonUnitalRingHom (α β : Type _) [NonUnitalNonAssocSemiring α]
  [NonUnitalNonAssocSemiring β] extends α →ₙ* β, α →+ β
#align non_unital_ring_hom NonUnitalRingHom

/-- `α →ₙ+* β` denotes the type of non-unital ring homomorphisms from `α` to `β`. -/
infixr:25 " →ₙ+* " => NonUnitalRingHom

/-- Reinterpret a non-unital ring homomorphism `f : α →ₙ+* β` as a semigroup
homomorphism `α →ₙ* β`. The `simp`-normal form is `(f : α →ₙ* β)`. -/
add_decl_doc NonUnitalRingHom.toMulHom
#align non_unital_ring_hom.to_mul_hom NonUnitalRingHom.toMulHom

/-- Reinterpret a non-unital ring homomorphism `f : α →ₙ+* β` as an additive
monoid homomorphism `α →+ β`. The `simp`-normal form is `(f : α →+ β)`. -/
add_decl_doc NonUnitalRingHom.toAddMonoidHom
#align non_unital_ring_hom.to_add_monoid_hom NonUnitalRingHom.toAddMonoidHom

section NonUnitalRingHomClass

/-- `NonUnitalRingHomClass F α β` states that `F` is a type of non-unital (semi)ring
homomorphisms. You should extend this class when you extend `NonUnitalRingHom`. -/
class NonUnitalRingHomClass (F : Type _) (α β : outParam (Type _)) [NonUnitalNonAssocSemiring α]
  [NonUnitalNonAssocSemiring β] extends MulHomClass F α β, AddMonoidHomClass F α β
#align non_unital_ring_hom_class NonUnitalRingHomClass

variable [NonUnitalNonAssocSemiring α] [NonUnitalNonAssocSemiring β] [NonUnitalRingHomClass F α β]

/-- Turn an element of a type `F` satisfying `NonUnitalRingHomClass F α β` into an actual
`NonUnitalRingHom`. This is declared as the default coercion from `F` to `α →ₙ+* β`. -/
@[coe]
def NonUnitalRingHomClass.toNonUnitalRingHom (f : F) : α →ₙ+* β :=
{ (f : α →ₙ* β), (f : α →+ β) with }

/-- Any type satisfying `NonUnitalRingHomClass` can be cast into `NonUnitalRingHom` via
`NonUnitalRingHomClass.toNonUnitalRingHom`. -/
instance : CoeTC F (α →ₙ+* β) :=
  ⟨NonUnitalRingHomClass.toNonUnitalRingHom⟩

end NonUnitalRingHomClass

namespace NonUnitalRingHom

section coe

/-!
Throughout this section, some `Semiring` arguments are specified with `{}` instead of `[]`.
See note [implicit instance arguments].
-/

variable {_ : NonUnitalNonAssocSemiring α} {_ : NonUnitalNonAssocSemiring β}

instance : NonUnitalRingHomClass (α →ₙ+* β) α β where
  coe f := f.toFun
  coe_injective' f g h := by
    cases f
    cases g
    congr
    apply FunLike.coe_injective'
    exact h
  map_add := NonUnitalRingHom.map_add'
  map_zero := NonUnitalRingHom.map_zero'
  map_mul f := f.map_mul'

-- Porting note:
-- These helper instances are unhelpful in Lean 4, so omitting:
-- /-- Helper instance for when there's too many metavariables to apply `fun_like.has_coe_to_fun`
-- directly. -/
-- instance : CoeFun (α →ₙ+* β) fun _ => α → β :=
--   ⟨fun f => f.toFun⟩

-- Porting note: removed due to new `coe` in Lean4
#noalign non_unital_ring_hom.to_fun_eq_coe
#noalign non_unital_ring_hom.coe_mk
#noalign non_unital_ring_hom.coe_coe

initialize_simps_projections NonUnitalRingHom (toFun → apply)

@[simp]
theorem coe_toMulHom (f : α →ₙ+* β) : ⇑f.toMulHom = f :=
  rfl
#align non_unital_ring_hom.coe_to_mul_hom NonUnitalRingHom.coe_toMulHom

@[simp]
theorem coe_mulHom_mk (f : α → β) (h₁ h₂ h₃) :
    ((⟨⟨f, h₁⟩, h₂, h₃⟩ : α →ₙ+* β) : α →ₙ* β) = ⟨f, h₁⟩ :=
  rfl
#align non_unital_ring_hom.coe_mul_hom_mk NonUnitalRingHom.coe_mulHom_mk

theorem coe_toAddMonoidHom (f : α →ₙ+* β) : ⇑f.toAddMonoidHom = f := rfl
#align non_unital_ring_hom.coe_to_add_monoid_hom NonUnitalRingHom.coe_toAddMonoidHom

@[simp]
theorem coe_addMonoidHom_mk (f : α → β) (h₁ h₂ h₃) :
    ((⟨⟨f, h₁⟩, h₂, h₃⟩ : α →ₙ+* β) : α →+ β) = ⟨⟨f, h₂⟩, h₃⟩ :=
  rfl
#align non_unital_ring_hom.coe_add_monoid_hom_mk NonUnitalRingHom.coe_addMonoidHom_mk

/-- Copy of a `RingHom` with a new `toFun` equal to the old one. Useful to fix definitional
equalities. -/
protected def copy (f : α →ₙ+* β) (f' : α → β) (h : f' = f) : α →ₙ+* β :=
  { f.toMulHom.copy f' h, f.toAddMonoidHom.copy f' h with }
#align non_unital_ring_hom.copy NonUnitalRingHom.copy

@[simp]
theorem coe_copy (f : α →ₙ+* β) (f' : α → β) (h : f' = f) : ⇑(f.copy f' h) = f' :=
  rfl
#align non_unital_ring_hom.coe_copy NonUnitalRingHom.coe_copy

theorem copy_eq (f : α →ₙ+* β) (f' : α → β) (h : f' = f) : f.copy f' h = f :=
  FunLike.ext' h
#align non_unital_ring_hom.copy_eq NonUnitalRingHom.copy_eq

end coe

section

variable {_ : NonUnitalNonAssocSemiring α} {_ : NonUnitalNonAssocSemiring β}
variable (f : α →ₙ+* β) {x y : α}

@[ext]
theorem ext ⦃f g : α →ₙ+* β⦄ : (∀ x, f x = g x) → f = g :=
  FunLike.ext _ _
#align non_unital_ring_hom.ext NonUnitalRingHom.ext

theorem ext_iff {f g : α →ₙ+* β} : f = g ↔ ∀ x, f x = g x :=
  FunLike.ext_iff
#align non_unital_ring_hom.ext_iff NonUnitalRingHom.ext_iff

@[simp]
theorem mk_coe (f : α →ₙ+* β) (h₁ h₂ h₃) : NonUnitalRingHom.mk (MulHom.mk f h₁) h₂ h₃ = f :=
  ext fun _ => rfl
#align non_unital_ring_hom.mk_coe NonUnitalRingHom.mk_coe

set_option linter.deprecated false in
theorem coe_mulHom_injective : Injective fun f : α →ₙ+* β => (f : α →ₙ* β) := fun _ _ h =>
  ext <| MulHom.congr_fun h
#align non_unital_ring_hom.coe_mul_hom_injective NonUnitalRingHom.coe_mulHom_injective

end

variable [NonUnitalNonAssocSemiring α] [NonUnitalNonAssocSemiring β]

/-- The identity non-unital ring homomorphism from a non-unital semiring to itself. -/
protected def id (α : Type _) [NonUnitalNonAssocSemiring α] : α →ₙ+* α := by
  refine' { toFun := id.. } <;> intros <;> rfl
#align non_unital_ring_hom.id NonUnitalRingHom.id

instance : Zero (α →ₙ+* β) :=
  ⟨{ toFun := 0, map_mul' := fun _ _ => (mul_zero (0 : β)).symm, map_zero' := rfl,
      map_add' := fun _ _ => (add_zero (0 : β)).symm }⟩

instance : Inhabited (α →ₙ+* β) :=
  ⟨0⟩

@[simp]
theorem coe_zero : ⇑(0 : α →ₙ+* β) = 0 :=
  rfl
#align non_unital_ring_hom.coe_zero NonUnitalRingHom.coe_zero

@[simp]
theorem zero_apply (x : α) : (0 : α →ₙ+* β) x = 0 :=
  rfl
#align non_unital_ring_hom.zero_apply NonUnitalRingHom.zero_apply

@[simp]
theorem id_apply (x : α) : NonUnitalRingHom.id α x = x :=
  rfl
#align non_unital_ring_hom.id_apply NonUnitalRingHom.id_apply

@[simp]
theorem coe_addMonoidHom_id : (NonUnitalRingHom.id α : α →+ α) = AddMonoidHom.id α :=
  rfl
#align non_unital_ring_hom.coe_add_monoid_hom_id NonUnitalRingHom.coe_addMonoidHom_id

@[simp]
theorem coe_mulHom_id : (NonUnitalRingHom.id α : α →ₙ* α) = MulHom.id α :=
  rfl
#align non_unital_ring_hom.coe_mul_hom_id NonUnitalRingHom.coe_mulHom_id

variable {_ : NonUnitalNonAssocSemiring γ}

/-- Composition of non-unital ring homomorphisms is a non-unital ring homomorphism. -/
def comp (g : β →ₙ+* γ) (f : α →ₙ+* β) : α →ₙ+* γ :=
  { g.toMulHom.comp f.toMulHom, g.toAddMonoidHom.comp f.toAddMonoidHom with }
#align non_unital_ring_hom.comp NonUnitalRingHom.comp

/-- Composition of non-unital ring homomorphisms is associative. -/
theorem comp_assoc {δ} {_ : NonUnitalNonAssocSemiring δ} (f : α →ₙ+* β) (g : β →ₙ+* γ)
    (h : γ →ₙ+* δ) : (h.comp g).comp f = h.comp (g.comp f) :=
  rfl
#align non_unital_ring_hom.comp_assoc NonUnitalRingHom.comp_assoc

@[simp]
theorem coe_comp (g : β →ₙ+* γ) (f : α →ₙ+* β) : ⇑(g.comp f) = g ∘ f :=
  rfl
#align non_unital_ring_hom.coe_comp NonUnitalRingHom.coe_comp

@[simp]
theorem comp_apply (g : β →ₙ+* γ) (f : α →ₙ+* β) (x : α) : g.comp f x = g (f x) :=
  rfl
#align non_unital_ring_hom.comp_apply NonUnitalRingHom.comp_apply
variable (g : β →ₙ+* γ) (f : α →ₙ+* β)

@[simp]
theorem coe_comp_addMonoidHom (g : β →ₙ+* γ) (f : α →ₙ+* β) :
    AddMonoidHom.mk ⟨g ∘ f, (g.comp f).map_zero'⟩ (g.comp f).map_add' = (g : β →+ γ).comp f :=
  rfl
#align non_unital_ring_hom.coe_comp_add_monoid_hom NonUnitalRingHom.coe_comp_addMonoidHom

@[simp]
theorem coe_comp_mulHom (g : β →ₙ+* γ) (f : α →ₙ+* β) :
    MulHom.mk (g ∘ f) (g.comp f).map_mul' = (g : β →ₙ* γ).comp f :=
  rfl
#align non_unital_ring_hom.coe_comp_mul_hom NonUnitalRingHom.coe_comp_mulHom

@[simp]
theorem comp_zero (g : β →ₙ+* γ) : g.comp (0 : α →ₙ+* β) = 0 := by
  ext
  simp
#align non_unital_ring_hom.comp_zero NonUnitalRingHom.comp_zero

@[simp]
theorem zero_comp (f : α →ₙ+* β) : (0 : β →ₙ+* γ).comp f = 0 := by
  ext
  rfl
#align non_unital_ring_hom.zero_comp NonUnitalRingHom.zero_comp

@[simp]
theorem comp_id (f : α →ₙ+* β) : f.comp (NonUnitalRingHom.id α) = f :=
  ext fun _ => rfl
#align non_unital_ring_hom.comp_id NonUnitalRingHom.comp_id

@[simp]
theorem id_comp (f : α →ₙ+* β) : (NonUnitalRingHom.id β).comp f = f :=
  ext fun _ => rfl
#align non_unital_ring_hom.id_comp NonUnitalRingHom.id_comp

instance : MonoidWithZero (α →ₙ+* α) where
  one := NonUnitalRingHom.id α
  mul := comp
  mul_one := comp_id
  one_mul := id_comp
  mul_assoc f g h := comp_assoc _ _ _
  zero := 0
  mul_zero := comp_zero
  zero_mul := zero_comp

theorem one_def : (1 : α →ₙ+* α) = NonUnitalRingHom.id α :=
  rfl
#align non_unital_ring_hom.one_def NonUnitalRingHom.one_def

@[simp]
theorem coe_one : ⇑(1 : α →ₙ+* α) = id :=
  rfl
#align non_unital_ring_hom.coe_one NonUnitalRingHom.coe_one

theorem mul_def (f g : α →ₙ+* α) : f * g = f.comp g :=
  rfl
#align non_unital_ring_hom.mul_def NonUnitalRingHom.mul_def

@[simp]
theorem coe_mul (f g : α →ₙ+* α) : ⇑(f * g) = f ∘ g :=
  rfl
#align non_unital_ring_hom.coe_mul NonUnitalRingHom.coe_mul

theorem cancel_right {g₁ g₂ : β →ₙ+* γ} {f : α →ₙ+* β} (hf : Surjective f) :
    g₁.comp f = g₂.comp f ↔ g₁ = g₂ :=
  ⟨fun h => ext <| hf.forall.2 (ext_iff.1 h), fun h => h ▸ rfl⟩
#align non_unital_ring_hom.cancel_right NonUnitalRingHom.cancel_right

theorem cancel_left {g : β →ₙ+* γ} {f₁ f₂ : α →ₙ+* β} (hg : Injective g) :
    g.comp f₁ = g.comp f₂ ↔ f₁ = f₂ :=
  ⟨fun h => ext fun x => hg <| by rw [← comp_apply, h, comp_apply], fun h => h ▸ rfl⟩
#align non_unital_ring_hom.cancel_left NonUnitalRingHom.cancel_left

end NonUnitalRingHom

/-- Bundled semiring homomorphisms; use this for bundled ring homomorphisms too.

This extends from both `MonoidHom` and `MonoidWithZeroHom` in order to put the fields in a
sensible order, even though `MonoidWithZeroHom` already extends `MonoidHom`. -/
structure RingHom (α : Type _) (β : Type _) [NonAssocSemiring α] [NonAssocSemiring β] extends
  α →* β, α →+ β, α →ₙ+* β, α →*₀ β
#align ring_hom RingHom

/-- `α →+* β` denotes the type of ring homomorphisms from `α` to `β`. -/
infixr:25 " →+* " => RingHom

/-- Reinterpret a ring homomorphism `f : α →+* β` as a monoid with zero homomorphism `α →*₀ β`.
The `simp`-normal form is `(f : α →*₀ β)`. -/
add_decl_doc RingHom.toMonoidWithZeroHom
#align ring_hom.to_monoid_with_zero_hom RingHom.toMonoidWithZeroHom

/-- Reinterpret a ring homomorphism `f : α →+* β` as a monoid homomorphism `α →* β`.
The `simp`-normal form is `(f : α →* β)`. -/
add_decl_doc RingHom.toMonoidHom
#align ring_hom.to_monoid_hom RingHom.toMonoidHom

/-- Reinterpret a ring homomorphism `f : α →+* β` as an additive monoid homomorphism `α →+ β`.
The `simp`-normal form is `(f : α →+ β)`. -/
add_decl_doc RingHom.toAddMonoidHom
#align ring_hom.to_add_monoid_hom RingHom.toAddMonoidHom

/-- Reinterpret a ring homomorphism `f : α →+* β` as a non-unital ring homomorphism `α →ₙ+* β`. The
`simp`-normal form is `(f : α →ₙ+* β)`. -/
add_decl_doc RingHom.toNonUnitalRingHom
#align ring_hom.to_non_unital_ring_hom RingHom.toNonUnitalRingHom

section RingHomClass

/-- `RingHomClass F α β` states that `F` is a type of (semi)ring homomorphisms.
You should extend this class when you extend `RingHom`.

This extends from both `MonoidHomClass` and `MonoidWithZeroHomClass` in
order to put the fields in a sensible order, even though
`MonoidWithZeroHomClass` already extends `MonoidHomClass`. -/
class RingHomClass (F : Type _) (α β : outParam (Type _)) [NonAssocSemiring α]
  [NonAssocSemiring β] extends MonoidHomClass F α β, AddMonoidHomClass F α β,
  MonoidWithZeroHomClass F α β
#align ring_hom_class RingHomClass

set_option linter.deprecated false in
/-- Ring homomorphisms preserve `bit1`. -/
@[simp] lemma map_bit1 [NonAssocSemiring α] [NonAssocSemiring β] [RingHomClass F α β]
    (f : F) (a : α) : (f (bit1 a) : β) = bit1 (f a) := by simp [bit1]
#align map_bit1 map_bit1

-- Porting note: marked `{}` rather than `[]` to prevent dangerous instances
variable {_ : NonAssocSemiring α} {_ : NonAssocSemiring β} [RingHomClass F α β]

/-- Turn an element of a type `F` satisfying `RingHomClass F α β` into an actual
`RingHom`. This is declared as the default coercion from `F` to `α →+* β`. -/
@[coe]
def RingHomClass.toRingHom (f : F) : α →+* β :=
{ (f : α →* β), (f : α →+ β) with }

/-- Any type satisfying `RingHomClass` can be cast into `RingHom` via `RingHomClass.toRingHom`. -/
instance : CoeTC F (α →+* β) :=
  ⟨RingHomClass.toRingHom⟩

instance (priority := 100) RingHomClass.toNonUnitalRingHomClass : NonUnitalRingHomClass F α β :=
  { ‹RingHomClass F α β› with }
#align ring_hom_class.to_non_unital_ring_hom_class RingHomClass.toNonUnitalRingHomClass

end RingHomClass

namespace RingHom

section coe

/-!
Throughout this section, some `Semiring` arguments are specified with `{}` instead of `[]`.
See note [implicit instance arguments].
-/

variable {_ : NonAssocSemiring α} {_ : NonAssocSemiring β}

instance : RingHomClass (α →+* β) α β where
  coe f := f.toFun
  coe_injective' f g h := by
    cases f
    cases g
    congr
    apply FunLike.coe_injective'
    exact h
  map_add := RingHom.map_add'
  map_zero := RingHom.map_zero'
  map_mul f := f.map_mul'
  map_one f := f.map_one'

-- Porting note:
-- These helper instances are unhelpful in Lean 4, so omitting:
-- /-- Helper instance for when there's too many metavariables to apply `fun_like.has_coe_to_fun`
-- directly.
-- -/
-- instance : CoeFun (α →+* β) fun _ => α → β :=
--   ⟨RingHom.toFun⟩

initialize_simps_projections RingHom (toFun → apply)

-- Porting note: is this lemma still needed in Lean4?
-- Porting note: because `f.toFun` really means `f.toMonoidHom.toOneHom.toFun` and
-- `toMonoidHom_eq_coe` wants to simplify `f.toMonoidHom` to `(↑f : M →* N)`, this can't
-- be a simp lemma anymore
-- @[simp]
theorem toFun_eq_coe (f : α →+* β) : f.toFun = f :=
  rfl
#align ring_hom.to_fun_eq_coe RingHom.toFun_eq_coe

@[simp]
theorem coe_mk (f : α →* β) (h₁ h₂) : ((⟨f, h₁, h₂⟩ : α →+* β) : α → β) = f :=
  rfl
#align ring_hom.coe_mk RingHom.coe_mk

@[simp]
theorem coe_coe {F : Type _} [RingHomClass F α β] (f : F) : ((f : α →+* β) : α → β) = f :=
  rfl
#align ring_hom.coe_coe RingHom.coe_coe

attribute [coe] RingHom.toMonoidHom

instance coeToMonoidHom : Coe (α →+* β) (α →* β) :=
  ⟨RingHom.toMonoidHom⟩
#align ring_hom.has_coe_monoid_hom RingHom.coeToMonoidHom

-- Porting note: `dsimp only` can prove this
#noalign ring_hom.coe_monoid_hom

@[simp]
theorem toMonoidHom_eq_coe (f : α →+* β) : f.toMonoidHom = f :=
  rfl
#align ring_hom.to_monoid_hom_eq_coe RingHom.toMonoidHom_eq_coe

-- Porting note: this can't be a simp lemma anymore
-- @[simp]
theorem toMonoidWithZeroHom_eq_coe (f : α →+* β) : (f.toMonoidWithZeroHom : α → β) = f := by
  rfl
#align ring_hom.to_monoid_with_zero_hom_eq_coe RingHom.toMonoidWithZeroHom_eq_coe

@[simp]
theorem coe_monoidHom_mk (f : α →* β) (h₁ h₂) : ((⟨f, h₁, h₂⟩ : α →+* β) : α →* β) = f :=
  rfl
#align ring_hom.coe_monoid_hom_mk RingHom.coe_monoidHom_mk

-- Porting note: `dsimp only` can prove this
#noalign ring_hom.coe_add_monoid_hom

@[simp]
theorem toAddMonoidHom_eq_coe (f : α →+* β) : f.toAddMonoidHom = f :=
  rfl
#align ring_hom.to_add_monoid_hom_eq_coe RingHom.toAddMonoidHom_eq_coe

@[simp]
theorem coe_addMonoidHom_mk (f : α → β) (h₁ h₂ h₃ h₄) :
    ((⟨⟨⟨f, h₁⟩, h₂⟩, h₃, h₄⟩ : α →+* β) : α →+ β) = ⟨⟨f, h₃⟩, h₄⟩ :=
  rfl
#align ring_hom.coe_add_monoid_hom_mk RingHom.coe_addMonoidHom_mk

/-- Copy of a `RingHom` with a new `toFun` equal to the old one. Useful to fix definitional
equalities. -/
def copy (f : α →+* β) (f' : α → β) (h : f' = f) : α →+* β :=
  { f.toMonoidWithZeroHom.copy f' h, f.toAddMonoidHom.copy f' h with }
#align ring_hom.copy RingHom.copy

@[simp]
theorem coe_copy (f : α →+* β) (f' : α → β) (h : f' = f) : ⇑(f.copy f' h) = f' :=
  rfl
#align ring_hom.coe_copy RingHom.coe_copy

theorem copy_eq (f : α →+* β) (f' : α → β) (h : f' = f) : f.copy f' h = f :=
  FunLike.ext' h
#align ring_hom.copy_eq RingHom.copy_eq

end coe

section

variable {_ : NonAssocSemiring α} {_ : NonAssocSemiring β} (f : α →+* β) {x y : α}

theorem congr_fun {f g : α →+* β} (h : f = g) (x : α) : f x = g x :=
  FunLike.congr_fun h x
#align ring_hom.congr_fun RingHom.congr_fun

theorem congr_arg (f : α →+* β) {x y : α} (h : x = y) : f x = f y :=
  FunLike.congr_arg f h
#align ring_hom.congr_arg RingHom.congr_arg

theorem coe_inj ⦃f g : α →+* β⦄ (h : (f : α → β) = g) : f = g :=
  FunLike.coe_injective h
#align ring_hom.coe_inj RingHom.coe_inj

@[ext]
theorem ext ⦃f g : α →+* β⦄ : (∀ x, f x = g x) → f = g :=
  FunLike.ext _ _
#align ring_hom.ext RingHom.ext

theorem ext_iff {f g : α →+* β} : f = g ↔ ∀ x, f x = g x :=
  FunLike.ext_iff
#align ring_hom.ext_iff RingHom.ext_iff

@[simp]
theorem mk_coe (f : α →+* β) (h₁ h₂ h₃ h₄) : RingHom.mk ⟨⟨f, h₁⟩, h₂⟩ h₃ h₄ = f :=
  ext fun _ => rfl
#align ring_hom.mk_coe RingHom.mk_coe

theorem coe_addMonoidHom_injective : Injective (fun f : α →+* β => (f : α →+ β)) := fun _ _ h =>
  ext <| FunLike.congr_fun (F := α →+ β) h
#align ring_hom.coe_add_monoid_hom_injective RingHom.coe_addMonoidHom_injective

set_option linter.deprecated false in
theorem coe_monoidHom_injective : Injective (fun f : α →+* β => (f : α →* β)) := fun _ _ h =>
  ext <| MonoidHom.congr_fun h
#align ring_hom.coe_monoid_hom_injective RingHom.coe_monoidHom_injective

/-- Ring homomorphisms map zero to zero. -/
protected theorem map_zero (f : α →+* β) : f 0 = 0 :=
  map_zero f
#align ring_hom.map_zero RingHom.map_zero

/-- Ring homomorphisms map one to one. -/
protected theorem map_one (f : α →+* β) : f 1 = 1 :=
  map_one f
#align ring_hom.map_one RingHom.map_one

/-- Ring homomorphisms preserve addition. -/
protected theorem map_add (f : α →+* β) : ∀ a b, f (a + b) = f a + f b :=
  map_add f
#align ring_hom.map_add RingHom.map_add

/-- Ring homomorphisms preserve multiplication. -/
protected theorem map_mul (f : α →+* β) : ∀ a b, f (a * b) = f a * f b :=
  map_mul f
#align ring_hom.map_mul RingHom.map_mul

@[simp]
theorem map_ite_zero_one {F : Type _} [RingHomClass F α β] (f : F) (p : Prop) [Decidable p] :
    f (ite p 0 1) = ite p 0 1 := by
  split_ifs with h
  · simp only [h, ite_true]
    rw [map_zero]
  · simp only [h, ite_false]
    rw [map_one] -- Porting note: `simp` is unable to apply `map_zero` or `map_one`!?
#align ring_hom.map_ite_zero_one RingHom.map_ite_zero_one

@[simp]
theorem map_ite_one_zero {F : Type _} [RingHomClass F α β] (f : F) (p : Prop) [Decidable p] :
    f (ite p 1 0) = ite p 1 0 := by
  split_ifs with h
  · simp only [h, ite_true]
    rw [map_one]
  · simp only [h, ite_false]
    rw [map_zero] -- Porting note: `simp` is unable to apply `map_zero` or `map_one`!?
#align ring_hom.map_ite_one_zero RingHom.map_ite_one_zero

/-- `f : α →+* β` has a trivial codomain iff `f 1 = 0`. -/
theorem codomain_trivial_iff_map_one_eq_zero : (0 : β) = 1 ↔ f 1 = 0 := by rw [map_one, eq_comm]
#align ring_hom.codomain_trivial_iff_map_one_eq_zero RingHom.codomain_trivial_iff_map_one_eq_zero

/-- `f : α →+* β` has a trivial codomain iff it has a trivial range. -/
theorem codomain_trivial_iff_range_trivial : (0 : β) = 1 ↔ ∀ x, f x = 0 :=
  f.codomain_trivial_iff_map_one_eq_zero.trans
    ⟨fun h x => by rw [← mul_one x, map_mul, h, mul_zero], fun h => h 1⟩
#align ring_hom.codomain_trivial_iff_range_trivial RingHom.codomain_trivial_iff_range_trivial

/-- `f : α →+* β` has a trivial codomain iff its range is `{0}`. -/
theorem codomain_trivial_iff_range_eq_singleton_zero : (0 : β) = 1 ↔ Set.range f = {0} :=
  f.codomain_trivial_iff_range_trivial.trans
    ⟨fun h =>
      Set.ext fun y => ⟨fun ⟨x, hx⟩ => by simp [← hx, h x], fun hy => ⟨0, by simpa using hy.symm⟩⟩,
      fun h x => Set.mem_singleton_iff.mp (h ▸ Set.mem_range_self x)⟩
#align ring_hom.codomain_trivial_iff_range_eq_singleton_zero RingHom.codomain_trivial_iff_range_eq_singleton_zero

/-- `f : α →+* β` doesn't map `1` to `0` if `β` is nontrivial -/
theorem map_one_ne_zero [Nontrivial β] : f 1 ≠ 0 :=
  mt f.codomain_trivial_iff_map_one_eq_zero.mpr zero_ne_one
#align ring_hom.map_one_ne_zero RingHom.map_one_ne_zero

/-- If there is a homomorphism `f : α →+* β` and `β` is nontrivial, then `α` is nontrivial. -/
theorem domain_nontrivial [Nontrivial β] : Nontrivial α :=
  ⟨⟨1, 0, mt (fun h => show f 1 = 0 by rw [h, map_zero]) f.map_one_ne_zero⟩⟩
#align ring_hom.domain_nontrivial RingHom.domain_nontrivial

theorem codomain_trivial (f : α →+* β) [h : Subsingleton α] : Subsingleton β :=
  (subsingleton_or_nontrivial β).resolve_right fun _ =>
    not_nontrivial_iff_subsingleton.mpr h f.domain_nontrivial
#align ring_hom.codomain_trivial RingHom.codomain_trivial

end

/-- Ring homomorphisms preserve additive inverse. -/
protected theorem map_neg [NonAssocRing α] [NonAssocRing β] (f : α →+* β) (x : α) : f (-x) = -f x :=
  map_neg f x
#align ring_hom.map_neg RingHom.map_neg

/-- Ring homomorphisms preserve subtraction. -/
protected theorem map_sub [NonAssocRing α] [NonAssocRing β] (f : α →+* β) (x y : α) :
    f (x - y) = f x - f y :=
  map_sub f x y
#align ring_hom.map_sub RingHom.map_sub

/-- Makes a ring homomorphism from a monoid homomorphism of rings which preserves addition. -/
def mk' [NonAssocSemiring α] [NonAssocRing β] (f : α →* β)
    (map_add : ∀ a b, f (a + b) = f a + f b) : α →+* β :=
  { AddMonoidHom.mk' f map_add, f with }
#align ring_hom.mk' RingHom.mk'

section Semiring

variable [Semiring α] [Semiring β]

theorem isUnit_map (f : α →+* β) {a : α} : IsUnit a → IsUnit (f a) :=
  IsUnit.map f
#align ring_hom.is_unit_map RingHom.isUnit_map

protected theorem map_dvd (f : α →+* β) {a b : α} : a ∣ b → f a ∣ f b :=
  map_dvd f
#align ring_hom.map_dvd RingHom.map_dvd

end Semiring

variable {_ : NonAssocSemiring α} {_ : NonAssocSemiring β}

/-- The identity ring homomorphism from a semiring to itself. -/
def id (α : Type _) [NonAssocSemiring α] : α →+* α := by
  refine' { toFun := _root_.id.. } <;> intros <;> rfl
#align ring_hom.id RingHom.id

instance : Inhabited (α →+* α) :=
  ⟨id α⟩

@[simp]
theorem id_apply (x : α) : RingHom.id α x = x :=
  rfl
#align ring_hom.id_apply RingHom.id_apply

@[simp]
theorem coe_addMonoidHom_id : (id α : α →+ α) = AddMonoidHom.id α :=
  rfl
#align ring_hom.coe_add_monoid_hom_id RingHom.coe_addMonoidHom_id

@[simp]
theorem coe_monoidHom_id : (id α : α →* α) = MonoidHom.id α :=
  rfl
#align ring_hom.coe_monoid_hom_id RingHom.coe_monoidHom_id

variable {_ : NonAssocSemiring γ}

/-- Composition of ring homomorphisms is a ring homomorphism. -/
def comp (g : β →+* γ) (f : α →+* β) : α →+* γ :=
  { g.toNonUnitalRingHom.comp f.toNonUnitalRingHom with toFun := g ∘ f, map_one' := by simp }
#align ring_hom.comp RingHom.comp

/-- Composition of semiring homomorphisms is associative. -/
theorem comp_assoc {δ} {_ : NonAssocSemiring δ} (f : α →+* β) (g : β →+* γ) (h : γ →+* δ) :
    (h.comp g).comp f = h.comp (g.comp f) :=
  rfl
#align ring_hom.comp_assoc RingHom.comp_assoc

@[simp]
theorem coe_comp (hnp : β →+* γ) (hmn : α →+* β) : (hnp.comp hmn : α → γ) = hnp ∘ hmn :=
  rfl
#align ring_hom.coe_comp RingHom.coe_comp

theorem comp_apply (hnp : β →+* γ) (hmn : α →+* β) (x : α) :
    (hnp.comp hmn : α → γ) x = hnp (hmn x) :=
  rfl
#align ring_hom.comp_apply RingHom.comp_apply

@[simp]
theorem comp_id (f : α →+* β) : f.comp (id α) = f :=
  ext fun _ => rfl
#align ring_hom.comp_id RingHom.comp_id

@[simp]
theorem id_comp (f : α →+* β) : (id β).comp f = f :=
  ext fun _ => rfl
#align ring_hom.id_comp RingHom.id_comp

instance : Monoid (α →+* α) where
  one := id α
  mul := comp
  mul_one := comp_id
  one_mul := id_comp
  mul_assoc f g h := comp_assoc _ _ _

theorem one_def : (1 : α →+* α) = id α :=
  rfl
#align ring_hom.one_def RingHom.one_def

theorem mul_def (f g : α →+* α) : f * g = f.comp g :=
  rfl
#align ring_hom.mul_def RingHom.mul_def

@[simp]
theorem coe_one : ⇑(1 : α →+* α) = _root_.id :=
  rfl
#align ring_hom.coe_one RingHom.coe_one

@[simp]
theorem coe_mul (f g : α →+* α) : ⇑(f * g) = f ∘ g :=
  rfl
#align ring_hom.coe_mul RingHom.coe_mul

theorem cancel_right {g₁ g₂ : β →+* γ} {f : α →+* β} (hf : Surjective f) :
    g₁.comp f = g₂.comp f ↔ g₁ = g₂ :=
  ⟨fun h => RingHom.ext <| hf.forall.2 (ext_iff.1 h), fun h => h ▸ rfl⟩
#align ring_hom.cancel_right RingHom.cancel_right

theorem cancel_left {g : β →+* γ} {f₁ f₂ : α →+* β} (hg : Injective g) :
    g.comp f₁ = g.comp f₂ ↔ f₁ = f₂ :=
  ⟨fun h => RingHom.ext fun x => hg <| by rw [← comp_apply, h, comp_apply], fun h => h ▸ rfl⟩
#align ring_hom.cancel_left RingHom.cancel_left

end RingHom

/-- Pullback `IsDomain` instance along an injective function. -/
protected theorem Function.Injective.isDomain [Ring α] [IsDomain α] [Ring β] (f : β →+* α)
    (hf : Injective f) : IsDomain β := by
  haveI := pullback_nonzero f f.map_zero f.map_one
  haveI := IsRightCancelMulZero.to_noZeroDivisors α
  haveI := hf.noZeroDivisors f f.map_zero f.map_mul
  exact NoZeroDivisors.to_isDomain β
#align function.injective.is_domain Function.Injective.isDomain

namespace AddMonoidHom

variable [CommRing α] [IsDomain α] [CommRing β] (f : β →+ α)

-- Porting note: there's some disagreement over the naming scheme here.
-- This could perhaps be `mkRingHom_of_mul_self_of_two_ne_zero`.
-- See https://leanprover.zulipchat.com/#narrow/stream/287929-mathlib4/topic/naming.20conventions/near/315558410
/-- Make a ring homomorphism from an additive group homomorphism from a commutative ring to an
integral domain that commutes with self multiplication, assumes that two is nonzero and `1` is sent
to `1`. -/
def mkRingHomOfMulSelfOfTwoNeZero (h : ∀ x, f (x * x) = f x * f x) (h_two : (2 : α) ≠ 0)
    (h_one : f 1 = 1) : β →+* α :=
  { f with
    map_one' := h_one,
    map_mul' := fun x y => by
      have hxy := h (x + y)
      rw [mul_add, add_mul, add_mul, f.map_add, f.map_add, f.map_add, f.map_add, h x, h y, add_mul,
        mul_add, mul_add, ← sub_eq_zero, add_comm (f x * f x + f (y * x)), ← sub_sub, ← sub_sub,
        ← sub_sub, mul_comm y x, mul_comm (f y) (f x)] at hxy
      simp only [add_assoc, add_sub_assoc, add_sub_cancel'_right] at hxy
      rw [sub_sub, ← two_mul, ← add_sub_assoc, ← two_mul, ← mul_sub, mul_eq_zero (M₀ := α),
        sub_eq_zero, or_iff_not_imp_left] at hxy
      exact hxy h_two }
#align add_monoid_hom.mk_ring_hom_of_mul_self_of_two_ne_zero AddMonoidHom.mkRingHomOfMulSelfOfTwoNeZero

@[simp]
theorem coe_fn_mkRingHomOfMulSelfOfTwoNeZero (h h_two h_one) :
    (f.mkRingHomOfMulSelfOfTwoNeZero h h_two h_one : β → α) = f :=
  rfl
#align add_monoid_hom.coe_fn_mk_ring_hom_of_mul_self_of_two_ne_zero AddMonoidHom.coe_fn_mkRingHomOfMulSelfOfTwoNeZero

-- Porting note: `simp` can prove this
-- @[simp]
theorem coe_addMonoidHom_mkRingHomOfMulSelfOfTwoNeZero (h h_two h_one) :
    (f.mkRingHomOfMulSelfOfTwoNeZero h h_two h_one : β →+ α) = f := by
  apply AddMonoidHom.ext -- Porting note: why isn't `ext` picking up this lemma?
  intro
  rfl
#align add_monoid_hom.coe_add_monoid_hom_mk_ring_hom_of_mul_self_of_two_ne_zero AddMonoidHom.coe_addMonoidHom_mkRingHomOfMulSelfOfTwoNeZero

end AddMonoidHom


import tableau order.lexicographic

open matrix fintype finset function pequiv partition
variables {m n : ℕ}

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

namespace tableau

def pivot_col (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
    ∧ c ∉ T.dead))
  (((list.fin_range n).filter (λ c : fin n, 0 < T.to_matrix obj c ∧ c ∉ T.dead)).argmin
    T.to_partition.colg)
  some

def to_lex (T : tableau m n) (c : fin n) (r' : fin m) : lex ℚ (fin (m + n)) :=
(abs (T.const r' 0 / T.to_matrix r' c), T.to_partition.rowg r')

lemma to_lex_le_iff (T : tableau m n) (c : fin n) (i i' : fin m) :
  to_lex T c i ≤ to_lex T c i' ↔
  abs (T.const i 0 / T.to_matrix i c) < abs (T.const i' 0 / T.to_matrix i' c) ∨
    (abs (T.const i 0 / T.to_matrix i c) = abs (T.const i' 0 / T.to_matrix i' c) ∧
    T.to_partition.rowg i ≤ T.to_partition.rowg i') :=
prod.lex_def _ _

def pivot_row (T : tableau m n) (obj: fin m) (c : fin n) : option (fin m) :=
let l := (list.fin_range m).filter (λ i : fin m, obj ≠ i ∧ T.to_partition.rowg i ∈ T.restricted
  ∧ T.to_matrix obj c < 0) in
list.argmin (to_lex T c) l

lemma pivot_col_spec {T : tableau m n} {obj : fin m} {c : fin n} :
  c ∈ pivot_col T obj → ((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)) ∧ c ∉ T.dead :=
begin
  dsimp only [pivot_col],
  cases h : fin.find (λ c : fin n, T.to_matrix obj c ≠ 0 ∧ T.to_partition.colg c ∉ T.restricted
    ∧ c ∉ T.dead),
  { have := not_and.1 (fin.find_eq_none_iff.1 h c) ∘ ne_of_gt,
    simp only [list.argmin_eq_some_iff, option.mem_def, list.mem_filter, list.mem_fin_range, gt]
      at * {contextual := tt},
    tauto },
  { finish [fin.find_eq_some_iff] }
end

lemma nonpos_of_lt_pivot_col {T : tableau m n} {obj : fin m} {c j : fin n}
  (hc : c ∈ pivot_col T obj) (hcres : T.to_partition.colg c ∈ T.restricted)
  (hdead : j ∉ T.dead) (hjc : T.to_partition.colg j < T.to_partition.colg c) :
  T.to_matrix obj j ≤ 0 :=
begin
  rw [pivot_col] at hc,
  cases h : fin.find (λ c, T.to_matrix obj c ≠ 0 ∧ colg (T.to_partition) c ∉ T.restricted
    ∧ c ∉ T.dead),
  { rw h at hc,
    refine le_of_not_lt (λ hj0, _),
    exact not_le_of_gt hjc ((list.mem_argmin_iff.1 hc).2.1 j
      (list.mem_filter.2 (by simp [hj0, hdead]))) },
  { rw h at hc,
    simp [*, fin.find_eq_some_iff] at * }
end

lemma pivot_col_eq_none_aux {T : tableau m n} {obj : fin m} (hT : T.feasible) {c : fin n} :
  pivot_col T obj = none → c ∉ T.dead →
  ((T.to_matrix obj c = 0 ∧ T.to_partition.colg c ∉ T.restricted)
    ∨ (T.to_matrix obj c ≤ 0 ∧ T.to_partition.colg c ∈ T.restricted)) :=
begin
  simp only [pivot_col],
  cases h : fin.find (λ c : fin n, T.to_matrix obj c ≠ 0 ∧ T.to_partition.colg c ∉ T.restricted
    ∧ c ∉ T.dead),
  { simp only [list.filter_eq_nil, list.argmin_eq_none, not_and', list.mem_fin_range,
      true_implies_iff, not_lt, fin.find_eq_none_iff, and_imp, not_not] at *,
    assume hnonneg hdead,
    by_cases hres : T.to_partition.colg c ∈ T.restricted; simp * at * },
  { simp }
end

lemma pivot_col_eq_none {T : tableau m n} {obj : fin m} (hT : T.feasible)
  (h : pivot_col T obj = none) : T.is_optimal (T.of_col 0) (T.to_partition.rowg obj) :=
is_optimal_of_col_zero hT
(λ j hj, begin
  have := pivot_col_eq_none_aux hT h hj,
  finish [lt_irrefl]
end)

lemma pivot_row_spec {T : tableau m n} {obj i : fin m} {c : fin n} :
  i ∈ pivot_row T obj c →
  obj ≠ i ∧ T.to_partition.rowg i ∈ T.restricted ∧
  T.to_matrix obj c / T.to_matrix i c < 0 ∧
  (∀ i' : fin m, obj ≠ i' → T.to_partition.rowg i' ∈ T.restricted →
    T.to_matrix obj c < 0 →
  abs (T.const i 0 / T.to_matrix i c) ≤ abs (T.const i' 0 / T.to_matrix i' c)) :=
begin
  simp only [list.mem_filter, pivot_row, option.mem_def,
    list.argmin_eq_some_iff, list.mem_fin_range, true_and, and_imp],
  simp only [to_lex_le_iff],
  intros hor hres hr0 h _,
  simp only [*, true_and, ne.def, not_false_iff],
  intros i' hoi' hres' hi0',
  cases h i' hoi' hres' hi0',
  { exact le_of_lt (by assumption) },
  { exact le_of_eq (by tauto) }
end

lemma nonneg_of_lt_pivot_row {T : tableau m n} {obj : fin m} {i i' : fin m} {c : fin n}
  (hc0 : 0 < T.to_matrix obj c) (hres : T.to_partition.rowg i' ∈ T.restricted)
  (hc : c ∈ pivot_col T obj) (hrow : i ∈ pivot_row T obj c)
  (hconst : T.const i' 0 = 0)
  (hjc : T.to_partition.rowg i' < T.to_partition.rowg i) :
  0 ≤ T.to_matrix i' c :=
if hobj : obj = i' then le_of_lt $ hobj ▸ hc0
else
le_of_not_gt $ λ hic, not_le_of_lt hjc
begin
  have := (list.argmin_eq_some_iff.1 hrow).2.1 i'
    (list.mem_filter.2 ⟨list.mem_fin_range _, hobj, hres, div_neg_of_pos_of_neg hc0 hic⟩),
  simp [hconst, not_lt_of_ge (abs_nonneg _), *, to_lex_le_iff] at *
end

lemma ne_zero_of_mem_pivot_row {T : tableau m n} {obj i : fin m} {c : fin n}
  (hrow : i ∈ pivot_row T obj c) : T.to_matrix i c ≠ 0 :=
assume hrc, by simpa [lt_irrefl, hrc] using pivot_row_spec hrow

lemma ne_zero_of_mem_pivot_col {T : tableau m n} {obj : fin m} {c : fin n}
  (hc : c ∈ pivot_col T obj) : T.to_matrix obj c ≠ 0 :=
λ h, by simpa [h, lt_irrefl] using pivot_col_spec hc

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

lemma pivot_row_eq_none {T : tableau m n} {obj : fin m} {c : fin n} (hT : T.feasible)
  (hrow : pivot_row T obj c = none) (hs : c ∈ pivot_col T obj) :
  T.is_unbounded_above (T.to_partition.rowg obj) :=
have hrow : ∀ i, obj ≠ i → T.to_partition.rowg i ∈ T.restricted →
    0 ≤ T.to_matrix obj c / T.to_matrix i c,
  from 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)) ∧ c ∉ T.dead,
  from pivot_col_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.1.elim and.right (λ h, (not_lt_of_gt hToc h.1).elim)) hc.2
    (λ 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))
    hc.2 hToc)

def feasible_of_mem_pivot_row_and_col {T : tableau m n} {obj : fin m} (hT : T.feasible) {c}
  (hc : c ∈ pivot_col T obj) {i} (hr : i ∈ pivot_row T obj c) :
  feasible (T.pivot i c) :=
begin
  have := pivot_col_spec hc,
  have := pivot_row_spec hr,
  have := @feasible_simplex_pivot _ _ _ obj hT i c,
  tauto
end

section blands_rule

local attribute [instance, priority 0] classical.dec
variable (obj : fin m)

def fickle (T T' : tableau m n) (v : fin (m + n)) : Prop :=
T.to_partition.rowp v ≠ T'.to_partition.rowp v ∨
T.to_partition.colp v ≠ T'.to_partition.colp v

lemma fickle_symm {T T' : tableau m n} {v : fin (m + n)} :
  fickle T T' v ↔ fickle T' T v :=
by simp [fickle, eq_comm]

lemma fickle_colg_iff_ne {T T' : tableau m n} {j : fin n} :
  fickle T T' (T.to_partition.colg j) ↔
  T.to_partition.colg j ≠ T'.to_partition.colg j :=
⟨λ h h', h.elim (by rw [rowp_colg_eq_none, h', rowp_colg_eq_none]; simp)
  (by rw [colp_colg, h', colp_colg]; simp),
λ h, or.inr $ λ h', h begin
  have : T'.to_partition.colp (T.to_partition.colg j) = some j,
  { simpa [eq_comm] using h' },
  rwa [← pequiv.eq_some_iff, colp_symm_eq_some_colg, option.some_inj, eq_comm] at this
end⟩

lemma fickle_rowg_iff_ne {T T' : tableau m n} {i : fin m} :
  fickle T T' (T.to_partition.rowg i) ↔
  T.to_partition.rowg i ≠ T'.to_partition.rowg i :=
⟨λ h h', h.elim (by rw [rowp_rowg, h', rowp_rowg]; simp)
  (by rw [colp_rowg_eq_none, h', colp_rowg_eq_none]; simp),
λ h, or.inl $ λ h', h begin
  have : T'.to_partition.rowp (T.to_partition.rowg i) = some i,
  { simpa [eq_comm] using h' },
  rwa [← pequiv.eq_some_iff, rowp_symm_eq_some_rowg, option.some_inj, eq_comm] at this
end⟩

lemma not_unique_row_and_unique_col {T T' : tableau m n} {i c c'}
  (hcobj0 : 0 < T.to_matrix obj c)
  (hc'obj0 : 0 < T'.to_matrix obj c')
  (hrc0 : T.to_matrix i c < 0)
  (hflat : T.flat = T'.flat)
  (hs : T.to_partition.rowg i = T'.to_partition.colg c')
  (hrobj : T.to_partition.rowg obj = T'.to_partition.rowg obj)
  (hfickle : ∀ i, (fickle T T' (T.to_partition.rowg i)) → T.const i 0 = 0)
  (hobj : T.const obj 0 = T'.const obj 0)
  (nonpos_of_colg_eq : ∀ j, j ≠ c' →
    T'.to_partition.colg j = T.to_partition.colg c → T'.to_matrix obj j ≤ 0)
  (unique_col : ∀ j,
    (fickle T' T (T'.to_partition.colg j)) → j ≠ c' → T'.to_matrix obj j ≤ 0)
  (unique_row : ∀ i' ≠ i, T.const i' 0 = 0 → fickle T T' (T.to_partition.rowg i') →
    0 ≤ T.to_matrix i' c) :
  false :=
let objr := T.to_partition.rowg obj in
let x := λ y : ℚ, T.of_col (y • (single c 0).to_matrix) in
have hxflatT' : ∀ {y}, x y ∈ flat T', from hflat ▸ λ _, of_col_mem_flat _ _,
have hxrow : ∀ y i, x y (T.to_partition.rowg i) 0 = T.const i 0 + y * T.to_matrix i c,
  by simp [x, of_col_single_rowg],
have hxcol : ∀ {y j}, j ≠ c → x y (T.to_partition.colg j) 0 = 0,
  from λ y j hjc, by simp [x, of_col_colg, pequiv.to_matrix, single_apply_of_ne hjc.symm],
have hxcolc : ∀ {y}, x y (T.to_partition.colg c) 0 = y, by simp [x, of_col_colg, pequiv.to_matrix],
let c_star : fin (m + n) → ℚ := λ v, option.cases_on (T'.to_partition.colp v) 0
  (T'.to_matrix obj) in
have hxobj : ∀ y, x y objr 0 = T.const obj 0 + y * T.to_matrix obj c, from λ y, hxrow _ _,
have hgetr : ∀ {y v}, c_star v * x y v 0 ≠ 0 → (T'.to_partition.colp v).is_some,
  from λ y v, by cases h : T'.to_partition.colp v; dsimp [c_star]; rw h; simp,
have c_star_eq_get : ∀ {v} (hv : (T'.to_partition.colp v).is_some),
    c_star v = T'.to_matrix obj (option.get hv),
  from λ v hv, by dsimp only [c_star]; conv_lhs{rw [← option.some_get hv]}; refl,
have hsummmn : ∀ {y}, sum univ (λ j, T'.to_matrix obj j * x y (T'.to_partition.colg j) 0) =
    sum univ (λ v, c_star v * x y v 0),
  from λ y, sum_bij_ne_zero (λ j _ _, T'.to_partition.colg j) (λ _ _ _, mem_univ _)
    (λ _ _ _ _ _ _ h, T'.to_partition.injective_colg h)
    (λ v _ h0, ⟨option.get (hgetr h0), mem_univ _,
      by rw [← c_star_eq_get (hgetr h0)]; simpa using h0, by simp⟩)
    (λ _ _ h0, by dsimp [c_star]; rw [colp_colg]),
have hgetc : ∀ {y v}, c_star v * x y v 0 ≠ 0 → v ≠ T.to_partition.colg c →
    (T.to_partition.rowp v).is_some,
  from λ y v, (eq_rowg_or_colg T.to_partition v).elim
    (λ ⟨i, hi⟩, by rw [hi, rowp_rowg]; simp)
    (λ ⟨j, hj⟩ h0 hvc,
      by rw [hj, hxcol (mt (congr_arg T.to_partition.colg) (hvc ∘ hj.trans)), mul_zero] at h0;
        exact (h0 rfl).elim),
have hsummmnn : ∀ {y}, (univ.erase (T.to_partition.colg c)).sum (λ v, c_star v * x y v 0) =
    univ.sum (λ i, c_star (T.to_partition.rowg i) * x y (T.to_partition.rowg i) 0),
  from λ y, eq.symm $ sum_bij_ne_zero (λ i _ _, T.to_partition.rowg i) (by simp)
    (λ _ _ _ _ _ _ h, T.to_partition.injective_rowg h)
    (λ v hvc h0, ⟨option.get (hgetc h0 (mem_erase.1 hvc).1), mem_univ _, by simpa using h0⟩)
    (by intros; refl),
have hsumm : ∀ {y}, univ.sum (λ i, c_star (T.to_partition.rowg i) * x y (T.to_partition.rowg i) 0) =
    univ.sum (λ i, c_star (T.to_partition.rowg i) * T.const i 0) +
    y * univ.sum (λ i, c_star (T.to_partition.rowg i) * T.to_matrix i c),
  from λ y, by simp only [hxrow, mul_add, add_mul, sum_add_distrib, mul_assoc,
    mul_left_comm _ y, mul_sum.symm],
have hxobj' : ∀ y, x y objr 0 = univ.sum (λ v, c_star v * x y v 0) + T'.const obj 0,
  from λ y, by dsimp [objr]; rw [hrobj, mem_flat_iff.1 hxflatT', hsummmn],
have hy : ∀ {y}, y * T.to_matrix obj c = c_star (T.to_partition.colg c) * y +
    univ.sum (λ i, c_star (T.to_partition.rowg i) * T.const i 0) +
      y * univ.sum (λ i, c_star (T.to_partition.rowg i) * T.to_matrix i c),
  from λ y, by rw [← add_left_inj (T.const obj 0), ← hxobj, hxobj',
    ← insert_erase (mem_univ (T.to_partition.colg c)), sum_insert (not_mem_erase _ _),
    hsummmnn, hobj, hsumm, hxcolc]; simp,
have hy' : ∀ (y), y * (T.to_matrix obj c - c_star (T.to_partition.colg c) -
    univ.sum (λ i, c_star (T.to_partition.rowg i) * T.to_matrix i c)) =
    univ.sum (λ i, c_star (T.to_partition.rowg i) * T.const i 0),
  from λ y, by rw [mul_sub, mul_sub, hy]; simp [mul_comm, mul_assoc, mul_left_comm],
have h0 : T.to_matrix obj c - c_star (T.to_partition.colg c) -
    univ.sum (λ i, c_star (T.to_partition.rowg i) * T.to_matrix i c) = 0,
  by rw [← (domain.mul_left_inj (@one_ne_zero ℚ _)), hy', ← hy' 0, zero_mul, mul_zero],
have hcolnec' : T'.to_partition.colp (T.to_partition.colg c) ≠ some c',
  from λ h,
    by simpa [hs.symm] using congr_arg T'.to_partition.colg (option.eq_some_iff_get_eq.1 h).snd,
have eq_of_roweqc' : ∀ {i'}, T'.to_partition.colp (T.to_partition.rowg i') = some c' → i' = i,
  from λ i' h, by simpa [hs.symm, T.to_partition.injective_rowg.eq_iff] using
    congr_arg T'.to_partition.colg (option.eq_some_iff_get_eq.1 h).snd,
have sumpos : 0 < univ.sum (λ i, c_star (T.to_partition.rowg i) * T.to_matrix i c),
  by rw [← sub_eq_zero.1 h0]; exact add_pos_of_pos_of_nonneg hcobj0
    (begin
      simp only [c_star, neg_nonneg],
      cases h : T'.to_partition.colp (T.to_partition.colg c) with j,
      { refl },
      { exact nonpos_of_colg_eq j (mt (congr_arg some) (h ▸ hcolnec'))
          (by rw [← (option.eq_some_iff_get_eq.1 h).snd]; simp) }
    end),
have hexi : ∃ i', 0 < c_star (T.to_partition.rowg i') * T.to_matrix i' c,
  from imp_of_not_imp_not _ _ (by simpa using @sum_nonpos _ _ (@univ (fin m) _)
    (λ i', c_star (T.to_partition.rowg i') * T.to_matrix i' c) _ _) sumpos,
let ⟨i', hi'⟩ := hexi in
have hi'0 : T.const i' 0 = 0, from hfickle i'
  (fickle_rowg_iff_ne.2 $
    λ h, by dsimp [c_star] at hi'; rw [h, colp_rowg_eq_none] at hi'; simpa [lt_irrefl] using hi'),
have hi'_some : (T'.to_partition.colp (T.to_partition.rowg i')).is_some,
  from option.ne_none_iff_is_some.1 (λ h, by dsimp only [c_star] at hi'; rw h at hi';
    simpa [lt_irrefl] using hi'),
have hi' : 0 < T'.to_matrix obj (option.get hi'_some) * T.to_matrix i' c,
  by dsimp only [c_star] at hi'; rwa [← option.some_get hi'_some] at hi',
have hii : i' ≠ i, from λ hir, begin
    have : option.get hi'_some = c', from T'.to_partition.injective_colg
      (by rw [colg_get_colp_symm, ← hs, hir]),
    rw [this, hir] at hi',
    exact not_lt_of_gt hi' (mul_neg_of_pos_of_neg hc'obj0 hrc0)
  end,
have hnec' : option.get hi'_some ≠ c',
  from λ eq_c', hii $ @eq_of_roweqc' i' (eq_c' ▸ by simp),
have hic0 : T.to_matrix i' c < 0,
  from neg_of_mul_pos_right hi' (unique_col _
    (by rw [fickle_colg_iff_ne]; simp) hnec'),
not_le_of_gt hic0 (unique_row _ hii hi'0
  (by rw [fickle_rowg_iff_ne, ← colg_get_colp_symm _ _ hi'_some]; exact colg_ne_rowg _ _ _))

inductive rel : tableau m n → tableau m n → Prop
| pivot : ∀ {T}, feasible T → ∀ {i c}, c ∈ pivot_col T obj →
  i ∈ pivot_row T obj c → rel (T.pivot i c) T
| trans_pivot : ∀ {T₁ T₂ i c}, rel T₁ T₂ → c ∈ pivot_col T₁ obj →
  i ∈ pivot_row T₁ obj c → rel (T₁.pivot i c) T₂

lemma feasible_of_rel_right {T T' : tableau m n} (h : rel obj T' T) : T.feasible :=
rel.rec_on h (by tauto) (by tauto)

lemma feasible_of_rel_left {T T' : tableau m n} (h : rel obj T' T) : T'.feasible :=
rel.rec_on h (λ _ hT _ _ hc hr, feasible_of_mem_pivot_row_and_col hT hc hr)
  (λ _ _ _ _ _ hc hr hT, feasible_of_mem_pivot_row_and_col hT hc hr)

/-- Slightly stronger recursor than the default recursor -/
@[elab_as_eliminator]
lemma rel.rec_on' {obj : fin m} {C : tableau m n → tableau m n → Prop} {T T' : tableau m n}
  (hrel : rel obj T T')
  (hpivot : ∀ {T : tableau m n} {i : fin m} {c : fin n},
     feasible T → c ∈ pivot_col T obj → i ∈ pivot_row T obj c → C (pivot T i c) T)
  (hpivot_trans : ∀ {T₁ T₂ : tableau m n} {i : fin m} {c : fin n},
    rel obj (T₁.pivot i c) T₁ → rel obj T₁ T₂ →
     c ∈ pivot_col T₁ obj →
     i ∈ pivot_row T₁ obj c → C (T₁.pivot i c) T₁ → C T₁ T₂ → C (pivot T₁ i c) T₂) :
  C T T' :=
rel.rec_on hrel (λ T hT i c  hc hr, hpivot hT hc hr) (λ T₁ T₂ i c hrelT₁₂ hc hr ih, hpivot_trans
  (rel.pivot (feasible_of_rel_left obj hrelT₁₂) hc hr) hrelT₁₂ hc hr
  (hpivot (feasible_of_rel_left obj hrelT₁₂) hc hr) ih)

lemma rel.trans {obj : fin m} {T₁ T₂ T₃ : tableau m n} (h₁₂ : rel obj T₁ T₂) :
  rel obj T₂ T₃ → rel obj T₁ T₃ :=
rel.rec_on h₁₂
  (λ T i c hT hc hr hrelT, rel.trans_pivot hrelT hc hr)
  (λ T₁ T₂ i c hrelT₁₂ hc hr ih hrelT₂₃, rel.trans_pivot (ih hrelT₂₃) hc hr)

instance : is_trans (tableau m n) (rel obj) := ⟨@rel.trans _ _ obj⟩

lemma flat_eq_of_rel {T T' : tableau m n} (h : rel obj T' T) : flat T' = flat T :=
rel.rec_on' h (λ _ _ _ _ _ hr, flat_pivot (ne_zero_of_mem_pivot_row hr))
  (λ _ _ _ _ _ _ _ _, eq.trans)

lemma rowg_obj_eq_of_rel {T T' : tableau m n} (h : rel obj T T') : T.to_partition.rowg obj =
  T'.to_partition.rowg obj :=
rel.rec_on' h (λ T i c hfT hc hr, by simp [rowg_swap_of_ne _ (pivot_row_spec hr).1])
  (λ _ _ _ _ _ _ _ _, eq.trans)

lemma restricted_eq_of_rel {T T' : tableau m n} (h : rel obj T T') : T.restricted = T'.restricted :=
rel.rec_on' h (λ _ _ _ _ _ _, rfl) (λ _ _ _ _ _ _ _ _, eq.trans)

lemma dead_eq_of_rel {T T' : tableau m n} (h : rel obj T T') : T.dead = T'.dead :=
rel.rec_on' h (λ _ _ _ _ _ _, rfl) (λ _ _ _ _ _ _ _ _, eq.trans)

lemma dead_eq_of_rel_or_eq {T T' : tableau m n} (h : T = T' ∨ rel obj T T') : T.dead = T'.dead :=
h.elim (congr_arg _) $ dead_eq_of_rel _

lemma exists_mem_pivot_row_col_of_rel {T T' : tableau m n} (h : rel obj T' T) :
  ∃ i c, c ∈ pivot_col T obj ∧ i ∈ pivot_row T obj c :=
rel.rec_on' h (λ _ i c _ hc hr, ⟨i, c, hc, hr⟩) (λ _ _ _ _ _ _ _ _ _, id)

lemma exists_mem_pivot_row_of_rel {T T' : tableau m n} (h : rel obj T' T) {c : fin n}
  (hc : c ∈ pivot_col T obj) : ∃ i, i ∈ pivot_row T obj c :=
let ⟨i, c', hc', hr⟩ := exists_mem_pivot_row_col_of_rel obj h in ⟨i, by simp * at *⟩

lemma exists_mem_pivot_col_of_fickle {T₁ T₂ : tableau m n} (h : rel obj T₂ T₁) {c : fin n} :
  fickle T₁ T₂ (T₁.to_partition.colg c) →
  ∃ T₃, (T₃ = T₁ ∨ rel obj T₃ T₁) ∧ (rel obj T₂ T₃) ∧
  T₃.to_partition.colg c = T₁.to_partition.colg c ∧
  c ∈ pivot_col T₃ obj :=
rel.rec_on' h begin
    assume T i c' hT hc' hr,
    rw fickle_colg_iff_ne,
    by_cases hcc : c = c',
    { subst hcc,
      exact λ _, ⟨T, or.inl rfl, rel.pivot hT hc' hr, rfl, hc'⟩ },
    { simp [colg_swap_of_ne _ hcc] }
  end
  (λ T₁ T₂ i c hrelp₁ hrel₁₂ hc hr ihp₁ ih₁₂,
    (imp_iff_not_or.1 ih₁₂).elim
      (λ ih₁₂, (imp_iff_not_or.1 ihp₁).elim
        (λ ihp₁ hf, (fickle_colg_iff_ne.1 hf (by simp [*, fickle_colg_iff_ne] at *)).elim)
        (λ ⟨T₃, hT₃⟩ hf, ⟨T₃,
          hT₃.1.elim (λ h, h.symm ▸ or.inr hrel₁₂) (λ h, or.inr $ h.trans hrel₁₂),
          hT₃.2.1, hT₃.2.2.1.trans (by simpa [eq_comm, fickle_colg_iff_ne] using ih₁₂), hT₃.2.2.2⟩))
      (λ ⟨T₃, hT₃⟩ hf, ⟨T₃, hT₃.1, hrelp₁.trans hT₃.2.1, hT₃.2.2⟩))

lemma exists_mem_pivot_row_of_fickle {T₁ T₂ : tableau m n} (h : rel obj T₂ T₁) (i : fin m) :
  fickle T₁ T₂ (T₁.to_partition.rowg i) →
  ∃ (T₃ : tableau m n) c, (T₃ = T₁ ∨ rel obj T₃ T₁) ∧ (rel obj T₂ T₃) ∧
    T₃.to_partition.rowg i = T₁.to_partition.rowg i ∧
    c ∈ pivot_col T₃ obj ∧ i ∈ pivot_row T₃ obj c :=
rel.rec_on' h
  begin
    assume T i' c hT hc hi',
    rw fickle_rowg_iff_ne,
    by_cases hii : i = i',
    { subst hii,
      exact λ _, ⟨T, c, or.inl rfl, rel.pivot hT hc hi', rfl, hc, hi'⟩ },
    { simp [rowg_swap_of_ne _ hii] }
  end
  (λ T₁ T₂ i c hrelp₁ hrel₁₂ hc hrow ihp₁ ih₁₂,
    (imp_iff_not_or.1 ih₁₂).elim
      (λ ih₁₂, (imp_iff_not_or.1 ihp₁).elim
        (λ ihp₁ hf, (fickle_rowg_iff_ne.1 hf (by simp [*, fickle_rowg_iff_ne] at *)).elim)
        (λ ⟨T₃, c', hT₃⟩ hf, ⟨T₃, c', hT₃.1.elim (λ h, h.symm ▸ or.inr hrel₁₂)
          (λ h, or.inr $ h.trans hrel₁₂),
            hT₃.2.1,
            hT₃.2.2.1.trans (by simpa [eq_comm, fickle_rowg_iff_ne] using ih₁₂),
            by clear_aux_decl; tauto⟩))
      (λ ⟨T₃, c', hT₃⟩ _, ⟨T₃, c', hT₃.1,
        (rel.pivot (feasible_of_rel_left _ hrel₁₂) hc hrow).trans hT₃.2.1, hT₃.2.2⟩))

lemma eq_or_rel_pivot_of_rel {T₁ T₂ : tableau m n} (h : rel obj T₁ T₂) : ∀ {i j}
  (hcol : j ∈ pivot_col T₂ obj) (hrow : i ∈ pivot_row T₂ obj j),
  T₁ = T₂.pivot i j ∨ rel obj T₁ (T₂.pivot i j) :=
rel.rec_on' h (λ T i c hT hc hr r' c' hc' hr', by simp * at *)
  (λ T₁ T₂ i c hrelp₁ hrel₁₂ hc hr ihp₁ ih₁₂ r' c' hc' hr',
    (ih₁₂ hc' hr').elim
      (λ ih₁₂, or.inr $ ih₁₂ ▸ rel.pivot (feasible_of_rel_left _ hrel₁₂) hc hr)
      (λ ih₁₂, or.inr $ (rel.pivot (feasible_of_rel_left _ hrel₁₂) hc hr).trans ih₁₂))

lemma exists_mem_pivot_col_of_mem_pivot_row {T : tableau m n} (hrelTT : rel obj T T)
  {i c} (hc : c ∈ pivot_col T obj) (hrow : i ∈ pivot_row T obj c) :
  ∃ (T' : tableau m n), c ∈ pivot_col T' obj ∧ T'.to_partition.colg c =
  T.to_partition.rowg i ∧ rel obj T' T ∧ rel obj T T' :=
have hrelTTp : rel obj T (T.pivot i c),
  from (eq_or_rel_pivot_of_rel _ hrelTT hc hrow).elim (λ h, h ▸ hrelTT ) id,
let ⟨T', hT'⟩ := exists_mem_pivot_col_of_fickle obj hrelTTp $ fickle_colg_iff_ne.2 $
  (show (T.pivot i c).to_partition.colg c ≠ T.to_partition.colg c, by simp) in
⟨T', hT'.2.2.2, by simp [hT'.2.2.1], hT'.1.elim
  (λ h, h.symm ▸ rel.pivot (feasible_of_rel_left _ hrelTT) hc hrow)
  (λ h, h.trans $ rel.pivot (feasible_of_rel_left _ hrelTT) hc hrow), hT'.2.1⟩

lemma exists_mem_pivot_col_of_fickle_row {T T' : tableau m n} (hrelTT' : rel obj T T') {i : fin m}
  (hrelT'T : rel obj T' T) (hrow : fickle T T' (T.to_partition.rowg i)) :
  ∃ (T₃ : tableau m n) c, c ∈ pivot_col T₃ obj ∧ T₃.to_partition.colg c =
  T.to_partition.rowg i ∧ rel obj T₃ T ∧ rel obj T T₃ :=
let ⟨T₃, c, hT₃, hrelT₃T, hrow₃, hc, hr⟩ :=
  exists_mem_pivot_row_of_fickle obj hrelT'T _ hrow in
let ⟨T₄, hT₄⟩ := exists_mem_pivot_col_of_mem_pivot_row obj
  (show rel obj T₃ T₃, from hT₃.elim (λ h, h.symm ▸ hrelTT'.trans hrelT'T)
    (λ h, h.trans $ hrelTT'.trans hrelT₃T)) hc hr in
⟨T₄, c, hT₄.1, hT₄.2.1.trans hrow₃, hT₄.2.2.1.trans $ hT₃.elim (λ h, h.symm ▸ hrelTT'.trans hrelT'T)
  (λ h, h.trans $ hrelTT'.trans hrelT'T), hrelTT'.trans (hrelT₃T.trans hT₄.2.2.2)⟩

lemma const_obj_le_of_rel {T₁ T₂ : tableau m n} (h : rel obj T₁ T₂) :
  T₂.const obj 0 ≤ T₁.const obj 0 :=
rel.rec_on' h (λ T i c hT hc hr,
    have hr' : _ := pivot_row_spec hr,
    simplex_const_obj_le hT (by tauto) (by tauto))
  (λ _ _ _ _ _ _ _ _ h₁ h₂, le_trans h₂ h₁)

lemma const_obj_eq_of_rel_of_rel {T₁ T₂ : tableau m n} (h₁₂ : rel obj T₁ T₂)
  (h₂₁ : rel obj T₂ T₁) : T₁.const obj 0 = T₂.const obj 0 :=
le_antisymm (const_obj_le_of_rel _ h₂₁) (const_obj_le_of_rel _ h₁₂)

lemma const_eq_const_of_const_obj_eq {T₁ T₂ : tableau m n} (h₁₂ : rel obj T₁ T₂) :
  ∀ (hobj : T₁.const obj 0 = T₂.const obj 0) (i : fin m), T₁.const i 0 = T₂.const i 0 :=
rel.rec_on' h₁₂
  (λ T i c hfT hc hrow hobj i',
    have hr0 : T.const i 0 = 0, from const_eq_zero_of_const_obj_eq hfT
      (ne_zero_of_mem_pivot_col hc) (ne_zero_of_mem_pivot_row hrow)
      (pivot_row_spec hrow).1 hobj,
    if hii : i' = i
      then by simp [hii, hr0]
      else by simp [const_pivot_of_ne _ hii, hr0])
  (λ T₁ T₂ i c hrelp₁ hrel₁₂ hc hr ihp₁ ih₁₂ hobj i',
    have hobjp : (pivot T₁ i c).const obj 0 = T₁.const obj 0,
      from le_antisymm (hobj.symm ▸ const_obj_le_of_rel _ hrel₁₂)
        (const_obj_le_of_rel _ hrelp₁),
    by rw [ihp₁ hobjp, ih₁₂ (hobjp.symm.trans hobj)])

lemma const_eq_zero_of_fickle_of_rel_self {T T' : tableau m n} (hrelTT' : rel obj T T')
  (hrelT'T : rel obj T' T) (i : fin m) (hrow : fickle T T' (T.to_partition.rowg i)) :
  T.const i 0 = 0 :=
let ⟨T₃, c, hT₃₁, hT'₃, hrow₃, hc, hi⟩ := exists_mem_pivot_row_of_fickle obj hrelT'T _ hrow in
have T₃.const i 0 = 0, from const_eq_zero_of_const_obj_eq
  (feasible_of_rel_right _ hT'₃) (ne_zero_of_mem_pivot_col hc)
  (ne_zero_of_mem_pivot_row hi) (pivot_row_spec hi).1
  (const_obj_eq_of_rel_of_rel _ (rel.pivot (feasible_of_rel_right _ hT'₃) hc hi)
    ((eq_or_rel_pivot_of_rel _ hT'₃ hc hi).elim
      (λ h, h ▸ hT₃₁.elim (λ h, h.symm ▸ hrelTT') (λ h, h.trans hrelTT'))
      (λ hrelT'p, hT₃₁.elim (λ h, h.symm ▸ hrelTT'.trans (h ▸ hrelT'p))
        (λ h, h.trans $ hrelTT'.trans hrelT'p)))),
have hobj : T₃.const obj 0 = T.const obj 0,
  from hT₃₁.elim (λ h, h ▸ rfl) (λ h, const_obj_eq_of_rel_of_rel _ h (hrelTT'.trans hT'₃)),
hT₃₁.elim (λ h, h ▸ this) (λ h, const_eq_const_of_const_obj_eq obj h hobj i ▸ this)

lemma colg_mem_restricted_of_rel_self {T : tableau m n} (hrelTT : rel obj T T)
  {c} (hc : c ∈ pivot_col T obj) : T.to_partition.colg c ∈ T.restricted :=
let ⟨i, hrow⟩ := exists_mem_pivot_row_of_rel obj hrelTT hc in
let ⟨T', c', hT', hrelTT', hrowcol, _, hi'⟩ := exists_mem_pivot_row_of_fickle obj
    ((eq_or_rel_pivot_of_rel _ hrelTT hc hrow).elim
      (λ h, show rel obj T (T.pivot i c), from h ▸ hrelTT) id) _
  (fickle_rowg_iff_ne.2 $
    show (T.pivot i c).to_partition.rowg i ≠ T.to_partition.rowg i, by simp) in
(restricted_eq_of_rel _ hrelTT').symm ▸ by convert (pivot_row_spec hi').2.1; simp [hrowcol]

lemma eq_zero_of_not_mem_restricted_of_rel_self {T : tableau m n} (hrelTT : rel obj T T)
  {j} (hjres : T.to_partition.colg j ∉ T.restricted) (hdead : j ∉ T.dead) : T.to_matrix obj j = 0 :=
let ⟨r, c, hc, hr⟩ := exists_mem_pivot_row_col_of_rel obj hrelTT in
have hcres : T.to_partition.colg c ∈ T.restricted,
  from colg_mem_restricted_of_rel_self obj hrelTT hc,
by_contradiction $ λ h0,
begin
  simp [pivot_col] at hc,
  cases h : fin.find (λ c, T.to_matrix obj c ≠ 0 ∧ colg (T.to_partition) c ∉ T.restricted
    ∧ c ∉ T.dead),
  { simp [*, fin.find_eq_none_iff] at * },
  { rw h at hc, clear_aux_decl,
    have := (fin.find_eq_some_iff.1 h).1,
    simp * at * }
end

lemma rel.irrefl {obj : fin m} : ∀ (T : tableau m n), ¬ rel obj T T :=
λ T1 hrelT1,
let ⟨iT1 , cT1, hrT1, hcT1⟩ := exists_mem_pivot_row_col_of_rel obj hrelT1 in
let ⟨t, ht⟩ := finset.max_of_mem
  (show T1.to_partition.colg cT1 ∈ univ.filter (λ v, ∃ (T' : tableau m n) (c : fin n),
      rel obj T' T' ∧ c ∈ pivot_col T' obj ∧ T'.to_partition.colg c = v),
    by simp only [true_and, mem_filter, mem_univ, exists_and_distrib_left];
      exact ⟨T1, hrelT1, cT1, hrT1, rfl⟩) in
let ⟨_, T', c', hrelTT'', hcT', hct⟩ := finset.mem_filter.1 (finset.mem_of_max ht) in
have htmax : ∀ (s : fin (m + n)) (T : tableau m n),
    rel obj T T → ∀ (j : fin n), pivot_col T obj = some j →
      T.to_partition.colg j = s → s ≤ t,
  by simpa using λ s (h : s ∈ _), finset.le_max_of_mem h ht,
let ⟨i, hiT'⟩ := exists_mem_pivot_row_of_rel obj hrelTT'' hcT' in
have hrelTT''p : rel obj T' (T'.pivot i c'),
  from (eq_or_rel_pivot_of_rel obj hrelTT'' hcT' hiT').elim (λ h, h ▸ hrelTT'') id,
let ⟨T, c, hTT', hrelT'T, hT'Tr, hc, hr⟩ := exists_mem_pivot_row_of_fickle obj
  hrelTT''p i (by rw fickle_symm; simp [fickle_colg_iff_ne]) in
have hfT' : feasible T', from feasible_of_rel_left _ hrelTT'',
have hfT : feasible T, from feasible_of_rel_right _ hrelT'T,
have hrelT'pT' : rel obj (T'.pivot i c') T', from rel.pivot hfT' hcT' hiT',
have hrelTT' : rel obj T T', from hTT'.elim (λ h, h.symm ▸ hrelT'pT') (λ h, h.trans hrelT'pT'),
have hrelTT : rel obj T T, from hrelTT'.trans hrelT'T,
have hc't : T.to_partition.colg c ≤ t, from htmax _ T hrelTT _ hc rfl,
have hoT'T : T'.const obj 0 = T.const obj 0, from const_obj_eq_of_rel_of_rel _ hrelT'T hrelTT',
have hfickle : ∀ i, fickle T T' (T.to_partition.rowg i) → T.const i 0 = 0,
  from const_eq_zero_of_fickle_of_rel_self obj hrelTT' hrelT'T,
have hobj : T.const obj 0 = T'.const obj 0, from const_obj_eq_of_rel_of_rel _ hrelTT' hrelT'T,
have hflat : T.flat = T'.flat, from flat_eq_of_rel obj hrelTT',
have hrobj : T.to_partition.rowg obj = T'.to_partition.rowg obj, from rowg_obj_eq_of_rel _ hrelTT',
have hs : T.to_partition.rowg i = T'.to_partition.colg c', by simpa using hT'Tr,
have hc'res : T'.to_partition.colg c' ∈ T'.restricted,
  from hs ▸ restricted_eq_of_rel _ hrelTT' ▸ (pivot_row_spec hr).2.1,
have hc'obj0 : 0 < T'.to_matrix obj c' ∧ c' ∉ T'.dead,
  by simpa [hc'res] using pivot_col_spec hcT',
have hcres : T.to_partition.colg c ∈ T.restricted,
  from colg_mem_restricted_of_rel_self obj hrelTT hc,
have hcobj0 : 0 < to_matrix T obj c ∧ c ∉ T.dead,
  by simpa [hcres] using pivot_col_spec hc,
have hrc0 : T.to_matrix i c < 0,
  from inv_neg'.1 $ neg_of_mul_neg_left (pivot_row_spec hr).2.2.1 (le_of_lt hcobj0.1),
have nonpos_of_colg_ne : ∀ j, (fickle T' T (T'.to_partition.colg j)) → j ≠ c' →
    T'.to_matrix obj j ≤ 0,
  from λ j hj hjc',
    let ⟨T₃, hT₃⟩ := exists_mem_pivot_col_of_fickle obj hrelTT' hj in
    nonpos_of_lt_pivot_col hcT' hc'res
      (dead_eq_of_rel_or_eq obj hT₃.1 ▸ (pivot_col_spec hT₃.2.2.2).2)
      (lt_of_le_of_ne
        (hct.symm ▸ hT₃.2.2.1 ▸ htmax _ T₃ (hT₃.1.elim (λ h, h.symm ▸ hrelTT'')
          (λ h, h.trans (hrelT'T.trans hT₃.2.1))) _ hT₃.2.2.2 rfl)
        (by rwa [ne.def, T'.to_partition.injective_colg.eq_iff])),
have nonpos_of_colg_eq : ∀ j, j ≠ c' →
    T'.to_partition.colg j = T.to_partition.colg c → T'.to_matrix obj j ≤ 0,
  from λ j hjc' hj,
    if hjc : j = c
    then by clear_aux_decl; subst hjc;
      exact nonpos_of_lt_pivot_col hcT' hc'res
        (by rw [dead_eq_of_rel obj hrelT'T]; tauto)
        (lt_of_le_of_ne (hj.symm ▸ hct.symm ▸ hc't) (by simpa))
    else nonpos_of_colg_ne _ (fickle_colg_iff_ne.2 $ by simpa [hj, eq_comm] using hjc) hjc',
have unique_row : ∀ i' ≠ i, T.const i' 0 = 0 → fickle T T' (T.to_partition.rowg i') →
    0 ≤ T.to_matrix i' c,
  from λ i' hii hi0 hrow,
    let ⟨T₃, c₃, hc₃, hrow₃, hrelT₃T, hrelTT₃⟩ :=
      exists_mem_pivot_col_of_fickle_row _ hrelTT' hrelT'T hrow in
    have hrelT₃T₃ : rel obj T₃ T₃, from hrelT₃T.trans hrelTT₃,
    nonneg_of_lt_pivot_row (by exact hcobj0.1)
      (by rw [← hrow₃, ← restricted_eq_of_rel _ hrelT₃T];
        exact colg_mem_restricted_of_rel_self _ hrelT₃T₃ hc₃) hc hr hi0
      (lt_of_le_of_ne (by rw [hs, hct, ← hrow₃]; exact htmax _ _ hrelT₃T₃ _ hc₃ rfl)
        (by simpa [fickle_rowg_iff_ne] using hrow)),
not_unique_row_and_unique_col obj hcobj0.1 hc'obj0.1 hrc0 hflat hs hrobj hfickle hobj
  nonpos_of_colg_eq nonpos_of_colg_ne unique_row

noncomputable instance fintype_rel (T : tableau m n) : fintype {T' | rel obj T' T} :=
fintype.of_injective (λ T', T'.val.to_partition)
  (λ T₁ T₂ h, subtype.eq $ tableau.ext
    (by rw [flat_eq_of_rel _ T₁.2, flat_eq_of_rel _ T₂.2]) h
    (by rw [dead_eq_of_rel _ T₁.2, dead_eq_of_rel _ T₂.2])
    (by rw [restricted_eq_of_rel _ T₁.2, restricted_eq_of_rel _ T₂.2]))

lemma rel_wf (m n : ℕ) (obj : fin m): well_founded (@rel m n obj) :=
subrelation.wf
  (show subrelation (@rel m n obj) (measure (λ T, fintype.card {T' | rel obj T' T})),
    from assume T₁ T₂ h,
    set.card_lt_card (set.ssubset_iff_subset_not_subset.2 ⟨λ T' hT', hT'.trans h,
      not_forall_of_exists_not ⟨T₁, λ h', rel.irrefl _ (h' h)⟩⟩))
  (measure_wf (λ T, fintype.card {T' | rel obj T' T}))

end blands_rule

inductive termination (n : ℕ) : Type
| while {}              : termination
| unbounded (c : fin n) : termination
| optimal {}            : termination

namespace termination

lemma injective_unbounded : function.injective (@unbounded n) :=
λ _ _ h, by injection h

@[simp] lemma unbounded_inj {c c' : fin n} : unbounded c = unbounded c' ↔ c = c' :=
injective_unbounded.eq_iff

end termination

open termination

instance {n : ℕ} : has_repr $ termination n :=
⟨λ t, termination.cases_on t
  "while"
  (λ c, "unbounded " ++ repr c)
  "optimal"⟩

open termination

/-- The simplex algorithm -/
def simplex (w : tableau m n → bool) (obj : fin m) : Π (T : tableau m n) (hT : feasible T),
  tableau m n × termination n
| T := λ hT, cond (w T)
  (match pivot_col T obj, @feasible_of_mem_pivot_row_and_col _ _ _ obj hT,
      @rel.pivot m n obj _ hT with
    | none,   hc, hrel := (T, optimal)
    | some j, hc, hrel :=
      match pivot_row T obj j, @hc _ rfl, (λ i, @hrel i j rfl) with
      | none,   hrow, hrel := (T, unbounded j)
      | some i, hrow, hrel := have wf : rel obj (pivot T i j) T, from hrel _ rfl,
        simplex (T.pivot i j) (hrow rfl)
      end
    end)
  (T, while)
using_well_founded {rel_tac := λ _ _, `[exact ⟨_, rel_wf m n obj⟩],
  dec_tac := tactic.assumption}

lemma simplex_pivot {w : tableau m n → bool} {T : tableau m n} (hT : feasible T)
  (hw : w T = tt) {obj : fin m} {i : fin m} {c : fin n}
  (hc : c ∈ pivot_col T obj) (hr : i ∈ pivot_row T obj c) :
  (T.pivot i c).simplex w obj  (feasible_of_mem_pivot_row_and_col hT hc hr) =
  T.simplex w obj hT  :=
by conv_rhs { rw simplex };
  simp [hw, show _ = _, from hr, show _ = _, from hc, simplex._match_1, simplex._match_2]

lemma simplex_spec_aux (w : tableau m n → bool) (obj : fin m) :
  Π (T : tableau m n) (hT : feasible T),
  ((T.simplex w obj hT).2 = while ∧ w (T.simplex w obj hT).1 = ff) ∨
  ((T.simplex w obj hT).2 = optimal ∧ w (T.simplex w obj hT).1 = tt ∧
    pivot_col (T.simplex w obj hT).1 obj = none) ∨
  ∃ c, ((T.simplex w obj hT).2 = unbounded c ∧ w (T.simplex w obj hT).1 = tt ∧
    c ∈ pivot_col (T.simplex w obj hT).1 obj ∧
    pivot_row (T.simplex w obj hT).1 obj c = none)
| T := λ hT,
  begin
    cases hw : w T,
    { rw simplex, simp [hw] },
    { cases hc : pivot_col T obj with c,
      { rw simplex, simp [hc, hw, simplex._match_1] },
      { cases hrow : pivot_row T obj c with i,
        { rw simplex,
          simp [hrow, hc, hw, simplex._match_1, simplex._match_2] },
        { rw [← simplex_pivot hT hw hc hrow],
          exact have wf : rel obj (T.pivot i c) T, from rel.pivot hT hc hrow,
            simplex_spec_aux _ _ } } }
  end
using_well_founded {rel_tac := λ _ _, `[exact ⟨_, rel_wf m n obj⟩],
  dec_tac := tactic.assumption}

lemma simplex_while_eq_ff {w : tableau m n → bool} {T : tableau m n} {hT : feasible T}
  {obj : fin m} (hw : w T = ff) : T.simplex w obj hT = (T, while) :=
by rw [simplex, hw]; refl

lemma simplex_pivot_col_eq_none {w : tableau m n → bool} {T : tableau m n} {hT : feasible T}
  (hw : w T = tt) {obj : fin m} (hc : pivot_col T obj = none) :
  T.simplex w obj hT = (T, optimal) :=
by rw simplex; simp [hc, hw, simplex._match_1]

lemma simplex_pivot_row_eq_none {w : tableau m n → bool} {T : tableau m n} {hT : feasible T}
  {obj : fin m} (hw : w T = tt) {c} (hc : c ∈ pivot_col T obj)
  (hr : pivot_row T obj c = none) : T.simplex w obj hT = (T, unbounded c) :=
by rw simplex; simp [hw, show _ = _, from hc, hr, simplex._match_1, simplex._match_2]

lemma simplex_induction (P : tableau m n → Prop) (w : tableau m n → bool) (obj : fin m):
  Π {T : tableau m n} (hT : feasible T)  (h0 : P T)
  (hpivot : ∀ {T' i c}, w T' = tt → c ∈ pivot_col T' obj → i ∈ pivot_row T' obj c
    → feasible T' → P T' → P (T'.pivot i c)),
  P (T.simplex w obj hT).1
| T := λ hT h0 hpivot,
  begin
    cases hw : w T,
    { rwa [simplex_while_eq_ff hw] },
    { cases hc : pivot_col T obj with c,
      { rwa [simplex_pivot_col_eq_none hw hc] },
      { cases hrow : pivot_row T obj c with i,
        { rwa simplex_pivot_row_eq_none hw hc hrow },
        { rw [← simplex_pivot _ hw hc hrow],
          exact have wf : rel obj (pivot T i c) T, from rel.pivot hT hc hrow,
            simplex_induction (feasible_of_mem_pivot_row_and_col hT hc hrow)
              (hpivot hw hc hrow hT h0) @hpivot } } }
  end
using_well_founded {rel_tac := λ _ _, `[exact ⟨_, rel_wf m n obj⟩],
  dec_tac := `[tauto]}

@[simp] lemma feasible_simplex {w : tableau m n → bool} {T : tableau m n}
  {hT : feasible T} {obj : fin m} : feasible (T.simplex w obj hT).1 :=
simplex_induction feasible _ _ hT hT
  (λ _ _ _ _ hc hr _ hT', feasible_of_mem_pivot_row_and_col hT' hc hr)

@[simp] lemma simplex_simplex {w : tableau m n → bool} {T : tableau m n} {hT : feasible T}
  {obj : fin m} : (T.simplex w obj hT).1.simplex w obj feasible_simplex = T.simplex w obj hT :=
simplex_induction (λ T', ∀ (hT' : feasible T'), T'.simplex w obj hT' = T.simplex w obj hT) w _ _
  (λ _, rfl) (λ T' i c hw hc hr hT' ih hpivot, by rw [simplex_pivot hT' hw hc hr, ih]) _

/-- `simplex` does not move the row variable it is trying to maximise. -/
@[simp] lemma rowg_simplex (T : tableau m n) (hT : feasible T) (w : tableau m n → bool)
  (obj : fin m) : (T.simplex w obj hT).1.to_partition.rowg obj = T.to_partition.rowg obj :=
simplex_induction (λ T', T'.to_partition.rowg obj = T.to_partition.rowg obj) _ _ _ rfl
  (λ T' i c hw hc hr, by simp [rowg_swap_of_ne _ (pivot_row_spec hr).1])

@[simp] lemma flat_simplex (T : tableau m n) (hT : feasible T) (w : tableau m n → bool)
  (obj : fin m) : (T.simplex w obj hT).1.flat = T.flat :=
simplex_induction (λ T', T'.flat = T.flat) w obj _ rfl
  (λ T' i c hw hc hr hT' ih,
    have T'.to_matrix i c ≠ 0,
      from λ h, by simpa [h, lt_irrefl] using pivot_row_spec hr,
    by rw [flat_pivot this, ih])

@[simp] lemma restricted_simplex (T : tableau m n) (hT : feasible T) (w : tableau m n → bool)
  (obj : fin m) : (T.simplex w obj hT).1.restricted = T.restricted :=
simplex_induction (λ T', T'.restricted = T.restricted) _ _ _ rfl (by simp { contextual := tt })

@[simp] lemma dead_simplex (T : tableau m n) (hT : feasible T) (w : tableau m n → bool)
  (obj : fin m) : (T.simplex w obj hT).1.dead = T.dead :=
simplex_induction (λ T', T'.dead = T.dead) _ _ _ rfl (by simp { contextual := tt })

@[simp] lemma res_set_simplex (T : tableau m n) (hT : feasible T) (w : tableau m n → bool)
  (obj : fin m) : (T.simplex w obj hT).1.res_set = T.res_set :=
simplex_induction (λ T', T'.res_set = T.res_set) w obj _ rfl
  (λ T' i c hw hc hr, by simp [res_set_pivot (ne_zero_of_mem_pivot_row hr)] {contextual := tt})

@[simp] lemma dead_set_simplex (T : tableau m n) (hT : feasible T) (w : tableau m n → bool)
  (obj : fin m) : (T.simplex w obj hT).1.dead_set = T.dead_set :=
simplex_induction (λ T', T'.dead_set = T.dead_set) w obj _ rfl
  (λ T' i c hw hc hr,
    by simp [dead_set_pivot (ne_zero_of_mem_pivot_row hr) (pivot_col_spec hc).2] {contextual := tt})

@[simp] lemma sol_set_simplex (T : tableau m n) (hT : feasible T) (w : tableau m n → bool)
  (obj : fin m) : (T.simplex w obj hT).1.sol_set = T.sol_set :=
by simp [sol_set_eq_res_set_inter_dead_set]

@[simp] lemma of_col_simplex_zero_mem_sol_set {w : tableau m n → bool} {T : tableau m n}
  {hT : feasible T} {obj : fin m} : (T.simplex w obj hT).1.of_col 0 ∈ sol_set T :=
by rw [← sol_set_simplex, of_col_zero_mem_sol_set_iff]; exact feasible_simplex

@[simp] lemma of_col_simplex_rowg {w : tableau m n → bool} {T : tableau m n}
  {hT : feasible T} {obj : fin m} (x : cvec n) :
  (T.simplex w obj hT).1.of_col x (T.to_partition.rowg obj) =
  ((T.simplex w obj hT).1.to_matrix ⬝ x + (T.simplex w obj hT).1.const) obj :=
by rw [← of_col_rowg (T.simplex w obj hT).1 x obj, rowg_simplex]

@[simp] lemma is_unbounded_above_simplex {T : tableau m n} {hT : feasible T} {w : tableau m n → bool}
  {obj : fin m} {v : fin (m + n)} : is_unbounded_above (T.simplex w obj hT).1 v ↔
  is_unbounded_above T v := by simp [is_unbounded_above]

@[simp] lemma is_optimal_simplex {T : tableau m n} {hT : feasible T} {w : tableau m n → bool}
  {obj : fin m} {x : cvec (m + n)} {v : fin (m + n)} : is_optimal (T.simplex w obj hT).1 x v ↔
  is_optimal T x v := by simp [is_optimal]

lemma termination_eq_while_iff {T : tableau m n} {hT : feasible T} {w : tableau m n → bool}
  {obj : fin m} : (T.simplex w obj hT).2 = while ↔ w (T.simplex w obj hT).1 = ff :=
by have := simplex_spec_aux w obj T hT; finish

lemma termination_eq_optimal_iff_pivot_col_eq_none {T : tableau m n}
  {hT : feasible T} {w : tableau m n → bool} {obj : fin m} : (T.simplex w obj hT).2 = optimal ↔
  w (T.simplex w obj hT).1 = tt ∧ pivot_col (T.simplex w obj hT).1 obj = none :=
by rcases simplex_spec_aux w obj T hT with _ | ⟨_, _, _⟩ | ⟨⟨_, _⟩, _, _, _, _⟩; simp * at *

lemma termination_eq_unbounded_iff_pivot_row_eq_none {T : tableau m n} {hT : feasible T}
  {w : tableau m n → bool} {obj : fin m} {c : fin n} :
  (T.simplex w obj hT).2 = unbounded c ↔
  w (T.simplex w obj hT).1 = tt ∧ c ∈ pivot_col (T.simplex w obj hT).1 obj ∧
    pivot_row (T.simplex w obj hT).1 obj c = none :=
by split; intros; rcases simplex_spec_aux w obj T hT with
  _ | ⟨_, _, _⟩ | ⟨⟨⟨_, _⟩, _⟩, _, _, _, _⟩; simp * at *

lemma unbounded_of_termination_eq_unbounded {T : tableau m n} {hT : feasible T}
  {w : tableau m n → bool} {obj : fin m} {c : fin n} : (T.simplex w obj hT).2 = unbounded c →
  w (T.simplex w obj hT).1 = tt ∧
  is_unbounded_above T (T.to_partition.rowg obj) :=
begin
  rw termination_eq_unbounded_iff_pivot_row_eq_none,
  rintros ⟨_, hc⟩,
  simpa * using pivot_row_eq_none feasible_simplex hc.2 hc.1
end

lemma termination_eq_optimal_iff {T : tableau m n} {hT : feasible T}
  {w : tableau m n → bool} {obj : fin m} : (T.simplex w obj hT).2 = optimal ↔
  w (T.simplex w obj hT).1 = tt ∧
  is_optimal T ((T.simplex w obj hT).1.of_col 0) (T.to_partition.rowg obj) :=
begin
  rw [termination_eq_optimal_iff_pivot_col_eq_none],
  split,
  { rintros ⟨_, hc⟩,
    simpa * using pivot_col_eq_none feasible_simplex hc },
  { cases ht : (T.simplex w obj hT).2,
    { simp [*, termination_eq_while_iff] at * },
    { cases unbounded_of_termination_eq_unbounded ht,
      simp [*, not_optimal_of_unbounded_above right] },
    { simp [*, termination_eq_optimal_iff_pivot_col_eq_none] at * } }
end

lemma termination_eq_unbounded_iff {T : tableau m n} {hT : feasible T}
  {w : tableau m n → bool} {obj : fin m} {c : fin n}: (T.simplex w obj hT).2 = unbounded c ↔
  w (T.simplex w obj hT).1 = tt ∧ is_unbounded_above T (T.to_partition.rowg obj)
  ∧ c ∈ pivot_col (T.simplex w obj hT).1 obj :=
⟨λ hc, and.assoc.1 $ ⟨unbounded_of_termination_eq_unbounded hc,
  (termination_eq_unbounded_iff_pivot_row_eq_none.1 hc).2.1⟩,
begin
  have := @not_optimal_of_unbounded_above m n (T.simplex w obj hT).1 (T.to_partition.rowg obj)
    ((T.simplex w obj hT).1.of_col 0),
  cases ht : (T.simplex w obj hT).2;
  simp [termination_eq_optimal_iff, termination_eq_while_iff,
    termination_eq_unbounded_iff_pivot_row_eq_none, *] at *
end⟩

end tableau