/-
Copyright (c) 2017 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Tim Baumann, Stephen Morgan, Scott Morrison, Floris van Doorn

! This file was ported from Lean 3 source module category_theory.equivalence
! leanprover-community/mathlib commit 9aba7801eeecebb61f58a5763c2b6dd1b47dc6ef
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.CategoryTheory.Functor.FullyFaithful
import Mathlib.CategoryTheory.FullSubcategory
import Mathlib.CategoryTheory.Whiskering
import Mathlib.CategoryTheory.EssentialImage
import Mathlib.Tactic.Slice
/-!
# Equivalence of categories

An equivalence of categories `C` and `D` is a pair of functors `F : C ⥤ D` and `G : D ⥤ C` such
that `η : 𝟭 C ≅ F ⋙ G` and `ε : G ⋙ F ≅ 𝟭 D`. In many situations, equivalences are a better
notion of "sameness" of categories than the stricter isomorphims of categories.

Recall that one way to express that two functors `F : C ⥤ D` and `G : D ⥤ C` are adjoint is using
two natural transformations `η : 𝟭 C ⟶ F ⋙ G` and `ε : G ⋙ F ⟶ 𝟭 D`, called the unit and the
counit, such that the compositions `F ⟶ FGF ⟶ F` and `G ⟶ GFG ⟶ G` are the identity. Unfortunately,
it is not the case that the natural isomorphisms `η` and `ε` in the definition of an equivalence
automatically give an adjunction. However, it is true that
* if one of the two compositions is the identity, then so is the other, and
* given an equivalence of categories, it is always possible to refine `η` in such a way that the
  identities are satisfied.

For this reason, in mathlib we define an equivalence to be a "half-adjoint equivalence", which is
a tuple `(F, G, η, ε)` as in the first paragraph such that the composite `F ⟶ FGF ⟶ F` is the
identity. By the remark above, this already implies that the tuple is an "adjoint equivalence",
i.e., that the composite `G ⟶ GFG ⟶ G` is also the identity.

We also define essentially surjective functors and show that a functor is an equivalence if and only
if it is full, faithful and essentially surjective.

## Main definitions

* `Equivalence`: bundled (half-)adjoint equivalences of categories
* `IsEquivalence`: type class on a functor `F` containing the data of the inverse `G` as well as
  the natural isomorphisms `η` and `ε`.
* `EssSurj`: type class on a functor `F` containing the data of the preimages and the isomorphisms
  `F.obj (preimage d) ≅ d`.

## Main results

* `Equivalence.mk`: upgrade an equivalence to a (half-)adjoint equivalence
* `IsEquivalence.equivOfIso`: when `F` and `G` are isomorphic functors, `F` is an equivalence
iff `G` is.
* `Equivalence.ofFullyFaithfullyEssSurj`: a fully faithful essentially surjective functor is an
  equivalence.

## Notations

We write `C ≌ D` (`\backcong`, not to be confused with `≅`/`\cong`) for a bundled equivalence.

-/

namespace CategoryTheory

open CategoryTheory.Functor NatIso Category

-- declare the `v`'s first; see `CategoryTheory.Category` for an explanation
universe v₁ v₂ v₃ u₁ u₂ u₃

/-- We define an equivalence as a (half)-adjoint equivalence, a pair of functors with
  a unit and counit which are natural isomorphisms and the triangle law `Fη ≫ εF = 1`, or in other
  words the composite `F ⟶ FGF ⟶ F` is the identity.

  In `unit_inverse_comp`, we show that this is actually an adjoint equivalence, i.e., that the
  composite `G ⟶ GFG ⟶ G` is also the identity.

  The triangle equation is written as a family of equalities between morphisms, it is more
  complicated if we write it as an equality of natural transformations, because then we would have
  to insert natural transformations like `F ⟶ F1`.

See <https://stacks.math.columbia.edu/tag/001J>
-/
structure Equivalence (C : Type u₁) (D : Type u₂) [Category.{v₁} C] [Category.{v₂} D] where mk' ::
  /-- A functor in one direction -/
  functor : C ⥤ D
  /-- A functor in the other direction -/
  inverse : D ⥤ C
  /-- The composition `functor ⋙ inverse` is isomorphic to the identity -/
  unitIso : 𝟭 C ≅ functor ⋙ inverse
  /-- The composition `inverse ⋙ functor` is also isomorphic to the identity -/
  counitIso : inverse ⋙ functor ≅ 𝟭 D
  /-- The natural isomorphism compose to the identity -/
  functor_unitIso_comp :
    ∀ X : C, functor.map (unitIso.hom.app X) ≫ counitIso.hom.app (functor.obj X) =
      𝟙 (functor.obj X) := by aesop_cat
#align category_theory.equivalence CategoryTheory.Equivalence
#align category_theory.equivalence.unit_iso CategoryTheory.Equivalence.unitIso
#align category_theory.equivalence.counit_iso CategoryTheory.Equivalence.counitIso
#align category_theory.equivalence.functor_unit_iso_comp CategoryTheory.Equivalence.functor_unitIso_comp

/-- We infix the usual notation for an equivalence -/
infixr:10 " ≌ " => Equivalence

variable {C : Type u₁} [Category.{v₁} C] {D : Type u₂} [Category.{v₂} D]

namespace Equivalence

/-- The unit of an equivalence of categories. -/
abbrev unit (e : C ≌ D) : 𝟭 C ⟶ e.functor ⋙ e.inverse :=
  e.unitIso.hom
#align category_theory.equivalence.unit CategoryTheory.Equivalence.unit

/-- The counit of an equivalence of categories. -/
abbrev counit (e : C ≌ D) : e.inverse ⋙ e.functor ⟶ 𝟭 D :=
  e.counitIso.hom
#align category_theory.equivalence.counit CategoryTheory.Equivalence.counit

/-- The inverse of the unit of an equivalence of categories. -/
abbrev unitInv (e : C ≌ D) : e.functor ⋙ e.inverse ⟶ 𝟭 C :=
  e.unitIso.inv
#align category_theory.equivalence.unit_inv CategoryTheory.Equivalence.unitInv

/-- The inverse of the counit of an equivalence of categories. -/
abbrev counitInv (e : C ≌ D) : 𝟭 D ⟶ e.inverse ⋙ e.functor :=
  e.counitIso.inv
#align category_theory.equivalence.counit_inv CategoryTheory.Equivalence.counitInv

/- While these abbreviations are convenient, they also cause some trouble,
preventing structure projections from unfolding. -/
@[simp]
theorem Equivalence_mk'_unit (functor inverse unit_iso counit_iso f) :
    (⟨functor, inverse, unit_iso, counit_iso, f⟩ : C ≌ D).unit = unit_iso.hom :=
  rfl
#align category_theory.equivalence.equivalence_mk'_unit CategoryTheory.Equivalence.Equivalence_mk'_unit

@[simp]
theorem Equivalence_mk'_counit (functor inverse unit_iso counit_iso f) :
    (⟨functor, inverse, unit_iso, counit_iso, f⟩ : C ≌ D).counit = counit_iso.hom :=
  rfl
#align category_theory.equivalence.equivalence_mk'_counit CategoryTheory.Equivalence.Equivalence_mk'_counit

@[simp]
theorem Equivalence_mk'_unitInv (functor inverse unit_iso counit_iso f) :
    (⟨functor, inverse, unit_iso, counit_iso, f⟩ : C ≌ D).unitInv = unit_iso.inv :=
  rfl
#align category_theory.equivalence.equivalence_mk'_unit_inv CategoryTheory.Equivalence.Equivalence_mk'_unitInv

@[simp]
theorem Equivalence_mk'_counitInv (functor inverse unit_iso counit_iso f) :
    (⟨functor, inverse, unit_iso, counit_iso, f⟩ : C ≌ D).counitInv = counit_iso.inv :=
  rfl
#align category_theory.equivalence.equivalence_mk'_counit_inv CategoryTheory.Equivalence.Equivalence_mk'_counitInv

@[simp]
theorem functor_unit_comp (e : C ≌ D) (X : C) :
    e.functor.map (e.unit.app X) ≫ e.counit.app (e.functor.obj X) = 𝟙 (e.functor.obj X) :=
  e.functor_unitIso_comp X
#align category_theory.equivalence.functor_unit_comp CategoryTheory.Equivalence.functor_unit_comp

@[simp]
theorem counitInv_functor_comp (e : C ≌ D) (X : C) :
    e.counitInv.app (e.functor.obj X) ≫ e.functor.map (e.unitInv.app X) = 𝟙 (e.functor.obj X) :=
  by
  erw [Iso.inv_eq_inv (e.functor.mapIso (e.unitIso.app X) ≪≫ e.counitIso.app (e.functor.obj X))
      (Iso.refl _)]
  exact e.functor_unit_comp X
#align category_theory.equivalence.counit_inv_functor_comp CategoryTheory.Equivalence.counitInv_functor_comp

theorem counitInv_app_functor (e : C ≌ D) (X : C) :
    e.counitInv.app (e.functor.obj X) = e.functor.map (e.unit.app X) :=
  by
  symm
  erw [← Iso.comp_hom_eq_id (e.counitIso.app _), functor_unit_comp]
  rfl
#align category_theory.equivalence.counit_inv_app_functor CategoryTheory.Equivalence.counitInv_app_functor

theorem counit_app_functor (e : C ≌ D) (X : C) :
    e.counit.app (e.functor.obj X) = e.functor.map (e.unitInv.app X) :=
  by
  erw [← Iso.hom_comp_eq_id (e.functor.mapIso (e.unitIso.app X)), functor_unit_comp]
  rfl
#align category_theory.equivalence.counit_app_functor CategoryTheory.Equivalence.counit_app_functor

/-- The other triangle equality. The proof follows the following proof in Globular:
  http://globular.science/1905.001 -/
@[simp]
theorem unit_inverse_comp (e : C ≌ D) (Y : D) :
    e.unit.app (e.inverse.obj Y) ≫ e.inverse.map (e.counit.app Y) = 𝟙 (e.inverse.obj Y) :=
  by
  rw [← id_comp (e.inverse.map _), ← map_id e.inverse, ← counitInv_functor_comp, map_comp]
  dsimp
  rw [← Iso.hom_inv_id_assoc (e.unitIso.app _) (e.inverse.map (e.functor.map _)), app_hom, app_inv]
  slice_lhs 2 3 => erw [e.unit.naturality]
  slice_lhs 1 2 => erw [e.unit.naturality]
  slice_lhs 4 4 =>
    rw [← Iso.hom_inv_id_assoc (e.inverse.mapIso (e.counitIso.app _)) (e.unitInv.app _)]
  slice_lhs 3 4 =>
    erw [← map_comp e.inverse, e.counit.naturality]
    erw [(e.counitIso.app _).hom_inv_id, map_id]
  erw [id_comp]
  slice_lhs 2 3 => erw [← map_comp e.inverse, e.counitIso.inv.naturality, map_comp]
  slice_lhs 3 4 => erw [e.unitInv.naturality]
  slice_lhs 4 5 => erw [← map_comp (e.functor ⋙ e.inverse), (e.unitIso.app _).hom_inv_id, map_id]
  erw [id_comp]
  slice_lhs 3 4 => erw [← e.unitInv.naturality]
  slice_lhs 2 3 =>
    erw [← map_comp e.inverse, ← e.counitIso.inv.naturality, (e.counitIso.app _).hom_inv_id,
      map_id]
  erw [id_comp, (e.unitIso.app _).hom_inv_id]; rfl
#align category_theory.equivalence.unit_inverse_comp CategoryTheory.Equivalence.unit_inverse_comp

@[simp]
theorem inverse_counitInv_comp (e : C ≌ D) (Y : D) :
    e.inverse.map (e.counitInv.app Y) ≫ e.unitInv.app (e.inverse.obj Y) = 𝟙 (e.inverse.obj Y) :=
  by
  erw [Iso.inv_eq_inv (e.unitIso.app (e.inverse.obj Y) ≪≫ e.inverse.mapIso (e.counitIso.app Y))
      (Iso.refl _)]
  exact e.unit_inverse_comp Y
#align category_theory.equivalence.inverse_counit_inv_comp CategoryTheory.Equivalence.inverse_counitInv_comp

theorem unit_app_inverse (e : C ≌ D) (Y : D) :
    e.unit.app (e.inverse.obj Y) = e.inverse.map (e.counitInv.app Y) := by
  erw [← Iso.comp_hom_eq_id (e.inverse.mapIso (e.counitIso.app Y)), unit_inverse_comp]
  dsimp
#align category_theory.equivalence.unit_app_inverse CategoryTheory.Equivalence.unit_app_inverse

theorem unitInv_app_inverse (e : C ≌ D) (Y : D) :
    e.unitInv.app (e.inverse.obj Y) = e.inverse.map (e.counit.app Y) := by
  symm
  erw [← Iso.hom_comp_eq_id (e.unitIso.app _), unit_inverse_comp]
  rfl
#align category_theory.equivalence.unit_inv_app_inverse CategoryTheory.Equivalence.unitInv_app_inverse

@[simp]
theorem fun_inv_map (e : C ≌ D) (X Y : D) (f : X ⟶ Y) :
    e.functor.map (e.inverse.map f) = e.counit.app X ≫ f ≫ e.counitInv.app Y :=
  (NatIso.naturality_2 e.counitIso f).symm
#align category_theory.equivalence.fun_inv_map CategoryTheory.Equivalence.fun_inv_map

@[simp]
theorem inv_fun_map (e : C ≌ D) (X Y : C) (f : X ⟶ Y) :
    e.inverse.map (e.functor.map f) = e.unitInv.app X ≫ f ≫ e.unit.app Y :=
  (NatIso.naturality_1 e.unitIso f).symm
#align category_theory.equivalence.inv_fun_map CategoryTheory.Equivalence.inv_fun_map

section

-- In this section we convert an arbitrary equivalence to a half-adjoint equivalence.
variable {F : C ⥤ D} {G : D ⥤ C} (η : 𝟭 C ≅ F ⋙ G) (ε : G ⋙ F ≅ 𝟭 D)

/-- If `η : 𝟭 C ≅ F ⋙ G` is part of a (not necessarily half-adjoint) equivalence, we can upgrade it
to a refined natural isomorphism `adjointifyη η : 𝟭 C ≅ F ⋙ G` which exhibits the properties
required for a half-adjoint equivalence. See `Equivalence.mk`. -/
def adjointifyη : 𝟭 C ≅ F ⋙ G := by
  calc
    𝟭 C ≅ F ⋙ G := η
    _ ≅ F ⋙ 𝟭 D ⋙ G := isoWhiskerLeft F (leftUnitor G).symm
    _ ≅ F ⋙ (G ⋙ F) ⋙ G := isoWhiskerLeft F (isoWhiskerRight ε.symm G)
    _ ≅ F ⋙ G ⋙ F ⋙ G := isoWhiskerLeft F (associator G F G)
    _ ≅ (F ⋙ G) ⋙ F ⋙ G := (associator F G (F ⋙ G)).symm
    _ ≅ 𝟭 C ⋙ F ⋙ G := isoWhiskerRight η.symm (F ⋙ G)
    _ ≅ F ⋙ G := leftUnitor (F ⋙ G)
#align category_theory.equivalence.adjointify_η CategoryTheory.Equivalence.adjointifyη

theorem adjointify_η_ε (X : C) :
    F.map ((adjointifyη η ε).hom.app X) ≫ ε.hom.app (F.obj X) = 𝟙 (F.obj X) :=
  by
  dsimp [adjointifyη,Trans.trans]
  simp
  have := ε.hom.naturality (F.map (η.inv.app X)); dsimp at this; rw [this]; clear this
  rw [← assoc _ _ (F.map _)]
  have := ε.hom.naturality (ε.inv.app <| F.obj X); dsimp at this; rw [this]; clear this
  have := (ε.app <| F.obj X).hom_inv_id; dsimp at this; rw [this]; clear this
  rw [id_comp]; have := (F.mapIso <| η.app X).hom_inv_id; dsimp at this; rw [this]
#align category_theory.equivalence.adjointify_η_ε CategoryTheory.Equivalence.adjointify_η_ε

end

/-- Every equivalence of categories consisting of functors `F` and `G` such that `F ⋙ G` and
    `G ⋙ F` are naturally isomorphic to identity functors can be transformed into a half-adjoint
    equivalence without changing `F` or `G`. -/
protected def mk (F : C ⥤ D) (G : D ⥤ C) (η : 𝟭 C ≅ F ⋙ G) (ε : G ⋙ F ≅ 𝟭 D) : C ≌ D :=
  ⟨F, G, adjointifyη η ε, ε, adjointify_η_ε η ε⟩
#align category_theory.equivalence.mk CategoryTheory.Equivalence.mk

/-- Equivalence of categories is reflexive. -/
@[refl, simps]
def refl : C ≌ C :=
  ⟨𝟭 C, 𝟭 C, Iso.refl _, Iso.refl _, fun _ => Category.id_comp _⟩
#align category_theory.equivalence.refl CategoryTheory.Equivalence.refl

instance : Inhabited (C ≌ C) :=
  ⟨refl⟩

/-- Equivalence of categories is symmetric. -/
@[symm, simps]
def symm (e : C ≌ D) : D ≌ C :=
  ⟨e.inverse, e.functor, e.counitIso.symm, e.unitIso.symm, e.inverse_counitInv_comp⟩
#align category_theory.equivalence.symm CategoryTheory.Equivalence.symm

variable {E : Type u₃} [Category.{v₃} E]

/-- Equivalence of categories is transitive. -/
@[trans, simps]
def trans (e : C ≌ D) (f : D ≌ E) : C ≌ E
    where
  functor := e.functor ⋙ f.functor
  inverse := f.inverse ⋙ e.inverse
  unitIso := by
    refine' Iso.trans e.unitIso _
    exact isoWhiskerLeft e.functor (isoWhiskerRight f.unitIso e.inverse)
  counitIso := by
    refine' Iso.trans _ f.counitIso
    exact isoWhiskerLeft f.inverse (isoWhiskerRight e.counitIso f.functor)
  -- We wouldn't have needed to give this proof if we'd used `Equivalence.mk`,
  -- but we choose to avoid using that here, for the sake of good structure projection `simp`
  -- lemmas.
  functor_unitIso_comp X := by
    dsimp
    rw [← f.functor.map_comp_assoc, e.functor.map_comp, ← counitInv_app_functor, fun_inv_map,
      Iso.inv_hom_id_app_assoc, assoc, Iso.inv_hom_id_app, counit_app_functor, ← Functor.map_comp]
    erw [comp_id, Iso.hom_inv_id_app, Functor.map_id]
#align category_theory.equivalence.trans CategoryTheory.Equivalence.trans

/-- Composing a functor with both functors of an equivalence yields a naturally isomorphic
functor. -/
def funInvIdAssoc (e : C ≌ D) (F : C ⥤ E) : e.functor ⋙ e.inverse ⋙ F ≅ F :=
  (Functor.associator _ _ _).symm ≪≫ isoWhiskerRight e.unitIso.symm F ≪≫ F.leftUnitor
#align category_theory.equivalence.fun_inv_id_assoc CategoryTheory.Equivalence.funInvIdAssoc

@[simp]
theorem funInvIdAssoc_hom_app (e : C ≌ D) (F : C ⥤ E) (X : C) :
    (funInvIdAssoc e F).hom.app X = F.map (e.unitInv.app X) :=
  by
  dsimp [funInvIdAssoc]
  aesop_cat
#align category_theory.equivalence.fun_inv_id_assoc_hom_app CategoryTheory.Equivalence.funInvIdAssoc_hom_app

@[simp]
theorem funInvIdAssoc_inv_app (e : C ≌ D) (F : C ⥤ E) (X : C) :
    (funInvIdAssoc e F).inv.app X = F.map (e.unit.app X) :=
  by
  dsimp [funInvIdAssoc]
  aesop_cat
#align category_theory.equivalence.fun_inv_id_assoc_inv_app CategoryTheory.Equivalence.funInvIdAssoc_inv_app

/-- Composing a functor with both functors of an equivalence yields a naturally isomorphic
functor. -/
def invFunIdAssoc (e : C ≌ D) (F : D ⥤ E) : e.inverse ⋙ e.functor ⋙ F ≅ F :=
  (Functor.associator _ _ _).symm ≪≫ isoWhiskerRight e.counitIso F ≪≫ F.leftUnitor
#align category_theory.equivalence.inv_fun_id_assoc CategoryTheory.Equivalence.invFunIdAssoc

@[simp]
theorem invFunIdAssoc_hom_app (e : C ≌ D) (F : D ⥤ E) (X : D) :
    (invFunIdAssoc e F).hom.app X = F.map (e.counit.app X) :=
  by
  dsimp [invFunIdAssoc]
  aesop_cat
#align category_theory.equivalence.inv_fun_id_assoc_hom_app CategoryTheory.Equivalence.invFunIdAssoc_hom_app

@[simp]
theorem invFunIdAssoc_inv_app (e : C ≌ D) (F : D ⥤ E) (X : D) :
    (invFunIdAssoc e F).inv.app X = F.map (e.counitInv.app X) :=
  by
  dsimp [invFunIdAssoc]
  aesop_cat
#align category_theory.equivalence.inv_fun_id_assoc_inv_app CategoryTheory.Equivalence.invFunIdAssoc_inv_app

/-- If `C` is equivalent to `D`, then `C ⥤ E` is equivalent to `D ⥤ E`. -/
@[simps! functor inverse unitIso counitIso]
def congrLeft (e : C ≌ D) : C ⥤ E ≌ D ⥤ E :=
  Equivalence.mk ((whiskeringLeft _ _ _).obj e.inverse) ((whiskeringLeft _ _ _).obj e.functor)
    (NatIso.ofComponents (fun F => (e.funInvIdAssoc F).symm) (by aesop_cat))
    (NatIso.ofComponents (fun F => e.invFunIdAssoc F) (by aesop_cat))
#align category_theory.equivalence.congr_left CategoryTheory.Equivalence.congrLeft

/-- If `C` is equivalent to `D`, then `E ⥤ C` is equivalent to `E ⥤ D`. -/
@[simps! functor inverse unitIso counitIso]
def congrRight (e : C ≌ D) : E ⥤ C ≌ E ⥤ D :=
  Equivalence.mk ((whiskeringRight _ _ _).obj e.functor) ((whiskeringRight _ _ _).obj e.inverse)
    (NatIso.ofComponents
      (fun F => F.rightUnitor.symm ≪≫ isoWhiskerLeft F e.unitIso ≪≫ Functor.associator _ _ _)
      (by aesop_cat))
    (NatIso.ofComponents
      (fun F => Functor.associator _ _ _ ≪≫ isoWhiskerLeft F e.counitIso ≪≫ F.rightUnitor)
      (by aesop_cat))
#align category_theory.equivalence.congr_right CategoryTheory.Equivalence.congrRight

section CancellationLemmas

variable (e : C ≌ D)

/- We need special forms of `cancel_natIso_hom_right(_assoc)` and
`cancel_natIso_inv_right(_assoc)` for units and counits, because neither `simp` or `rw` will apply
those lemmas in this setting without providing `e.unitIso` (or similar) as an explicit argument.
We also provide the lemmas for length four compositions, since they're occasionally useful.
(e.g. in proving that equivalences take monos to monos) -/
@[simp]
theorem cancel_unit_right {X Y : C} (f f' : X ⟶ Y) :
    f ≫ e.unit.app Y = f' ≫ e.unit.app Y ↔ f = f' := by simp only [cancel_mono]
#align category_theory.equivalence.cancel_unit_right CategoryTheory.Equivalence.cancel_unit_right

@[simp]
theorem cancel_unitInv_right {X Y : C} (f f' : X ⟶ e.inverse.obj (e.functor.obj Y)) :
    f ≫ e.unitInv.app Y = f' ≫ e.unitInv.app Y ↔ f = f' := by simp only [cancel_mono]
#align category_theory.equivalence.cancel_unit_inv_right CategoryTheory.Equivalence.cancel_unitInv_right

@[simp]
theorem cancel_counit_right {X Y : D} (f f' : X ⟶ e.functor.obj (e.inverse.obj Y)) :
    f ≫ e.counit.app Y = f' ≫ e.counit.app Y ↔ f = f' := by simp only [cancel_mono]
#align category_theory.equivalence.cancel_counit_right CategoryTheory.Equivalence.cancel_counit_right

@[simp]
theorem cancel_counitInv_right {X Y : D} (f f' : X ⟶ Y) :
    f ≫ e.counitInv.app Y = f' ≫ e.counitInv.app Y ↔ f = f' := by simp only [cancel_mono]
#align category_theory.equivalence.cancel_counit_inv_right CategoryTheory.Equivalence.cancel_counitInv_right

@[simp]
theorem cancel_unit_right_assoc {W X X' Y : C} (f : W ⟶ X) (g : X ⟶ Y) (f' : W ⟶ X') (g' : X' ⟶ Y) :
    f ≫ g ≫ e.unit.app Y = f' ≫ g' ≫ e.unit.app Y ↔ f ≫ g = f' ≫ g' := by
  simp only [← Category.assoc, cancel_mono]
#align category_theory.equivalence.cancel_unit_right_assoc CategoryTheory.Equivalence.cancel_unit_right_assoc

@[simp]
theorem cancel_counitInv_right_assoc {W X X' Y : D} (f : W ⟶ X) (g : X ⟶ Y) (f' : W ⟶ X')
    (g' : X' ⟶ Y) : f ≫ g ≫ e.counitInv.app Y = f' ≫ g' ≫ e.counitInv.app Y ↔ f ≫ g = f' ≫ g' := by
  simp only [← Category.assoc, cancel_mono]
#align category_theory.equivalence.cancel_counit_inv_right_assoc CategoryTheory.Equivalence.cancel_counitInv_right_assoc

@[simp]
theorem cancel_unit_right_assoc' {W X X' Y Y' Z : C} (f : W ⟶ X) (g : X ⟶ Y) (h : Y ⟶ Z)
    (f' : W ⟶ X') (g' : X' ⟶ Y') (h' : Y' ⟶ Z) :
    f ≫ g ≫ h ≫ e.unit.app Z = f' ≫ g' ≫ h' ≫ e.unit.app Z ↔ f ≫ g ≫ h = f' ≫ g' ≫ h' := by
  simp only [← Category.assoc, cancel_mono]
#align category_theory.equivalence.cancel_unit_right_assoc' CategoryTheory.Equivalence.cancel_unit_right_assoc'

@[simp]
theorem cancel_counitInv_right_assoc' {W X X' Y Y' Z : D} (f : W ⟶ X) (g : X ⟶ Y) (h : Y ⟶ Z)
    (f' : W ⟶ X') (g' : X' ⟶ Y') (h' : Y' ⟶ Z) :
    f ≫ g ≫ h ≫ e.counitInv.app Z = f' ≫ g' ≫ h' ≫ e.counitInv.app Z ↔ f ≫ g ≫ h = f' ≫ g' ≫ h' :=
  by simp only [← Category.assoc, cancel_mono]
#align category_theory.equivalence.cancel_counit_inv_right_assoc' CategoryTheory.Equivalence.cancel_counitInv_right_assoc'

end CancellationLemmas

section

-- There's of course a monoid structure on `C ≌ C`,
-- but let's not encourage using it.
-- The power structure is nevertheless useful.
/-- Natural number powers of an auto-equivalence.  Use `(^)` instead. -/
def powNat (e : C ≌ C) : ℕ → (C ≌ C)
  | 0 => Equivalence.refl
  | 1 => e
  | n + 2 => e.trans (powNat e (n + 1))
#align category_theory.equivalence.pow_nat CategoryTheory.Equivalence.powNat

/-- Powers of an auto-equivalence.  Use `(^)` instead. -/
def pow (e : C ≌ C) : ℤ → (C ≌ C)
  | Int.ofNat n => e.powNat n
  | Int.negSucc n => e.symm.powNat (n + 1)
#align category_theory.equivalence.pow CategoryTheory.Equivalence.pow

instance : Pow (C ≌ C) ℤ :=
  ⟨pow⟩

@[simp]
theorem pow_zero (e : C ≌ C) : e ^ (0 : ℤ) = Equivalence.refl :=
  rfl
#align category_theory.equivalence.pow_zero CategoryTheory.Equivalence.pow_zero

@[simp]
theorem pow_one (e : C ≌ C) : e ^ (1 : ℤ) = e :=
  rfl
#align category_theory.equivalence.pow_one CategoryTheory.Equivalence.pow_one

@[simp]
theorem pow_neg_one (e : C ≌ C) : e ^ (-1 : ℤ) = e.symm :=
  rfl
#align category_theory.equivalence.pow_neg_one CategoryTheory.Equivalence.pow_neg_one

-- TODO as necessary, add the natural isomorphisms `(e^a).trans e^b ≅ e^(a+b)`.
-- At this point, we haven't even defined the category of equivalences.
end

end Equivalence

/-- A functor that is part of a (half) adjoint equivalence -/
class IsEquivalence (F : C ⥤ D) where mk' ::
  /-- The inverse functor to `F` -/
  inverse : D ⥤ C
  /-- Composition `F ⋙  inverse` is isomorphic to the identity. -/
  unitIso : 𝟭 C ≅ F ⋙ inverse
  /-- Composition `inverse ⋙ F` is isomorphic to the identity. =-/
  counitIso : inverse ⋙ F ≅ 𝟭 D
  /-- We natural isomorphisms are inverse -/
  functor_unitIso_comp :
    ∀ X : C,
      F.map ((unitIso.hom : 𝟭 C ⟶ F ⋙ inverse).app X) ≫ counitIso.hom.app (F.obj X) =
        𝟙 (F.obj X) := by
    aesop_cat
#align category_theory.is_equivalence CategoryTheory.IsEquivalence
#align category_theory.is_equivalence.unit_iso CategoryTheory.IsEquivalence.unitIso
#align category_theory.is_equivalence.counit_iso CategoryTheory.IsEquivalence.counitIso
#align category_theory.is_equivalence.functor_unit_iso_comp CategoryTheory.IsEquivalence.functor_unitIso_comp

attribute [reassoc (attr := simp)] IsEquivalence.functor_unitIso_comp

namespace IsEquivalence

instance ofEquivalence (F : C ≌ D) : IsEquivalence F.functor :=
  { F with }
#align category_theory.is_equivalence.of_equivalence CategoryTheory.IsEquivalence.ofEquivalence

instance ofEquivalenceInverse (F : C ≌ D) : IsEquivalence F.inverse :=
  IsEquivalence.ofEquivalence F.symm
#align category_theory.is_equivalence.of_equivalence_inverse CategoryTheory.IsEquivalence.ofEquivalenceInverse

open Equivalence

/-- To see that a functor is an equivalence, it suffices to provide an inverse functor `G` such that
    `F ⋙ G` and `G ⋙ F` are naturally isomorphic to identity functors. -/
protected def mk {F : C ⥤ D} (G : D ⥤ C) (η : 𝟭 C ≅ F ⋙ G) (ε : G ⋙ F ≅ 𝟭 D) : IsEquivalence F :=
  ⟨G, adjointifyη η ε, ε, adjointify_η_ε η ε⟩
#align category_theory.is_equivalence.mk CategoryTheory.IsEquivalence.mk

end IsEquivalence

namespace Functor

/-- Interpret a functor that is an equivalence as an equivalence. -/
def asEquivalence (F : C ⥤ D) [IsEquivalence F] : C ≌ D :=
  ⟨F, IsEquivalence.inverse F, IsEquivalence.unitIso, IsEquivalence.counitIso,
    IsEquivalence.functor_unitIso_comp⟩
#align category_theory.functor.as_equivalence CategoryTheory.Functor.asEquivalence

instance isEquivalenceRefl : IsEquivalence (𝟭 C) :=
  IsEquivalence.ofEquivalence Equivalence.refl
#align category_theory.functor.is_equivalence_refl CategoryTheory.Functor.isEquivalenceRefl

/-- The inverse functor of a functor that is an equivalence. -/
def inv (F : C ⥤ D) [IsEquivalence F] : D ⥤ C :=
  IsEquivalence.inverse F
#align category_theory.functor.inv CategoryTheory.Functor.inv

instance isEquivalenceInv (F : C ⥤ D) [IsEquivalence F] : IsEquivalence F.inv :=
  IsEquivalence.ofEquivalence F.asEquivalence.symm
#align category_theory.functor.is_equivalence_inv CategoryTheory.Functor.isEquivalenceInv

@[simp]
theorem asEquivalence_functor (F : C ⥤ D) [IsEquivalence F] : F.asEquivalence.functor = F :=
  rfl
#align category_theory.functor.as_equivalence_functor CategoryTheory.Functor.asEquivalence_functor

@[simp]
theorem asEquivalence_inverse (F : C ⥤ D) [IsEquivalence F] : F.asEquivalence.inverse = inv F :=
  rfl
#align category_theory.functor.as_equivalence_inverse CategoryTheory.Functor.asEquivalence_inverse

@[simp]
theorem asEquivalence_unit {F : C ⥤ D} [IsEquivalence F] :
    F.asEquivalence.unitIso = IsEquivalence.unitIso :=
  rfl
#align category_theory.functor.as_equivalence_unit CategoryTheory.Functor.asEquivalence_unit

@[simp]
theorem asEquivalence_counit {F : C ⥤ D} [IsEquivalence F] :
    F.asEquivalence.counitIso = IsEquivalence.counitIso :=
  rfl
#align category_theory.functor.as_equivalence_counit CategoryTheory.Functor.asEquivalence_counit

@[simp]
theorem inv_inv (F : C ⥤ D) [IsEquivalence F] : inv (inv F) = F :=
  rfl
#align category_theory.functor.inv_inv CategoryTheory.Functor.inv_inv

variable {E : Type u₃} [Category.{v₃} E]

instance isEquivalenceTrans (F : C ⥤ D) (G : D ⥤ E) [IsEquivalence F] [IsEquivalence G] :
    IsEquivalence (F ⋙ G) :=
  IsEquivalence.ofEquivalence (Equivalence.trans (asEquivalence F) (asEquivalence G))
#align category_theory.functor.is_equivalence_trans CategoryTheory.Functor.isEquivalenceTrans

end Functor

namespace Equivalence

@[simp]
theorem functor_inv (E : C ≌ D) : E.functor.inv = E.inverse :=
  rfl
#align category_theory.equivalence.functor_inv CategoryTheory.Equivalence.functor_inv

@[simp]
theorem inverse_inv (E : C ≌ D) : E.inverse.inv = E.functor :=
  rfl
#align category_theory.equivalence.inverse_inv CategoryTheory.Equivalence.inverse_inv

@[simp]
theorem functor_asEquivalence (E : C ≌ D) : E.functor.asEquivalence = E :=
  by
  cases E
  congr
#align category_theory.equivalence.functor_as_equivalence CategoryTheory.Equivalence.functor_asEquivalence

@[simp]
theorem inverse_asEquivalence (E : C ≌ D) : E.inverse.asEquivalence = E.symm :=
  by
  cases E
  congr
#align category_theory.equivalence.inverse_as_equivalence CategoryTheory.Equivalence.inverse_asEquivalence

end Equivalence

namespace IsEquivalence

@[simp]
theorem fun_inv_map (F : C ⥤ D) [IsEquivalence F] (X Y : D) (f : X ⟶ Y) :
    F.map (F.inv.map f) = F.asEquivalence.counit.app X ≫ f ≫ F.asEquivalence.counitInv.app Y :=
  by
  erw [NatIso.naturality_2]
  rfl
#align category_theory.is_equivalence.fun_inv_map CategoryTheory.IsEquivalence.fun_inv_map

@[simp]
theorem inv_fun_map (F : C ⥤ D) [IsEquivalence F] (X Y : C) (f : X ⟶ Y) :
    F.inv.map (F.map f) = F.asEquivalence.unitInv.app X ≫ f ≫ F.asEquivalence.unit.app Y :=
  by
  erw [NatIso.naturality_1]
  rfl
#align category_theory.is_equivalence.inv_fun_map CategoryTheory.IsEquivalence.inv_fun_map

/-- When a functor `F` is an equivalence of categories, and `G` is isomorphic to `F`, then
`G` is also an equivalence of categories. -/
@[simps!]
def ofIso {F G : C ⥤ D} (e : F ≅ G) (hF : IsEquivalence F) : IsEquivalence G
    where
  inverse := hF.inverse
  unitIso := hF.unitIso ≪≫ NatIso.hcomp e (Iso.refl hF.inverse)
  counitIso := NatIso.hcomp (Iso.refl hF.inverse) e.symm ≪≫ hF.counitIso
  functor_unitIso_comp X := by
    dsimp [NatIso.hcomp]
    erw [id_comp, F.map_id, comp_id]
    apply (cancel_epi (e.hom.app X)).mp
    slice_lhs 1 2 => rw [← e.hom.naturality]
    slice_lhs 2 3 => rw [← NatTrans.vcomp_app', e.hom_inv_id]
    simp only [NatTrans.id_app, id_comp, comp_id, F.map_comp, assoc]
    erw [hF.counitIso.hom.naturality]
    slice_lhs 1 2 => rw [functor_unitIso_comp]
    simp only [Functor.id_map, id_comp]
#align category_theory.is_equivalence.of_iso CategoryTheory.IsEquivalence.ofIso

/-- Compatibility of `ofIso` with the composition of isomorphisms of functors -/
theorem ofIso_trans {F G H : C ⥤ D} (e : F ≅ G) (e' : G ≅ H) (hF : IsEquivalence F) :
    ofIso e' (ofIso e hF) = ofIso (e ≪≫ e') hF :=
  by
  dsimp [ofIso]
  congr 1 <;> ext X <;> dsimp [NatIso.hcomp]
  · simp only [id_comp, assoc, Functor.map_comp]
  · simp only [Functor.map_id, comp_id, id_comp, assoc]
#align category_theory.is_equivalence.of_iso_trans CategoryTheory.IsEquivalence.ofIso_trans

/-- Compatibility of `ofIso` with identity isomorphisms of functors -/
theorem ofIso_refl (F : C ⥤ D) (hF : IsEquivalence F) : ofIso (Iso.refl F) hF = hF :=
  by
  rcases hF with ⟨Finv, Funit, Fcounit, Fcomp⟩
  dsimp [ofIso]
  congr 1 <;> ext X <;> dsimp [NatIso.hcomp]
  · simp only [comp_id, map_id]
  · simp only [id_comp, map_id]
#align category_theory.is_equivalence.of_iso_refl CategoryTheory.IsEquivalence.ofIso_refl

/-- When `F` and `G` are two isomorphic functors, then `F` is an equivalence iff `G` is. -/
@[simps]
def equivOfIso {F G : C ⥤ D} (e : F ≅ G) : IsEquivalence F ≃ IsEquivalence G
    where
  toFun := ofIso e
  invFun := ofIso e.symm
  left_inv hF := by rw [ofIso_trans, Iso.self_symm_id, ofIso_refl]
  right_inv hF := by rw [ofIso_trans, Iso.symm_self_id, ofIso_refl]
#align category_theory.is_equivalence.equiv_of_iso CategoryTheory.IsEquivalence.equivOfIso

/-- If `G` and `F ⋙ G` are equivalence of categories, then `F` is also an equivalence. -/
@[simp]
def cancelCompRight {E : Type _} [Category E] (F : C ⥤ D) (G : D ⥤ E) (hG : IsEquivalence G)
    (_ : IsEquivalence (F ⋙ G)) : IsEquivalence F :=
  ofIso (Functor.associator F G G.inv ≪≫ NatIso.hcomp (Iso.refl F) hG.unitIso.symm ≪≫ rightUnitor F)
    (Functor.isEquivalenceTrans (F ⋙ G) G.inv)
#align category_theory.is_equivalence.cancel_comp_right CategoryTheory.IsEquivalence.cancelCompRight

/-- If `F` and `F ⋙ G` are equivalence of categories, then `G` is also an equivalence. -/
@[simp]
def cancelCompLeft {E : Type _} [Category E] (F : C ⥤ D) (G : D ⥤ E) (hF : IsEquivalence F)
    (_ : IsEquivalence (F ⋙ G)) : IsEquivalence G :=
  ofIso
    ((Functor.associator F.inv F G).symm ≪≫ NatIso.hcomp hF.counitIso (Iso.refl G) ≪≫ leftUnitor G)
    (Functor.isEquivalenceTrans F.inv (F ⋙ G))
#align category_theory.is_equivalence.cancel_comp_left CategoryTheory.IsEquivalence.cancelCompLeft

end IsEquivalence

namespace Equivalence

/-- An equivalence is essentially surjective.

See <https://stacks.math.columbia.edu/tag/02C3>.
-/
theorem essSurj_of_equivalence (F : C ⥤ D) [IsEquivalence F] : EssSurj F :=
  ⟨fun Y => ⟨F.inv.obj Y, ⟨F.asEquivalence.counitIso.app Y⟩⟩⟩
#align category_theory.equivalence.ess_surj_of_equivalence CategoryTheory.Equivalence.essSurj_of_equivalence

-- see Note [lower instance priority]
/-- An equivalence is faithful.

See <https://stacks.math.columbia.edu/tag/02C3>.
-/
instance (priority := 100) faithfulOfEquivalence (F : C ⥤ D) [IsEquivalence F] : Faithful F where
  map_injective := @fun X Y f g h => by
    have p : F.inv.map (F.map f) = F.inv.map (F.map g) := congrArg F.inv.map h
    simpa only [cancel_epi, cancel_mono, IsEquivalence.inv_fun_map] using p
#align category_theory.equivalence.faithful_of_equivalence CategoryTheory.Equivalence.faithfulOfEquivalence

-- see Note [lower instance priority]
/-- An equivalence is full.

See <https://stacks.math.columbia.edu/tag/02C3>.
-/
instance (priority := 100) fullOfEquivalence (F : C ⥤ D) [IsEquivalence F] : Full F
    where
  preimage {X Y} f := F.asEquivalence.unit.app X ≫ F.inv.map f ≫ F.asEquivalence.unitInv.app Y
  witness {X Y} f :=
    F.inv.map_injective <| by
      simpa only [IsEquivalence.inv_fun_map, assoc, Iso.inv_hom_id_app_assoc,
        Iso.inv_hom_id_app] using comp_id _
#align category_theory.equivalence.full_of_equivalence CategoryTheory.Equivalence.fullOfEquivalence

@[simps]
private noncomputable def equivalenceInverse (F : C ⥤ D) [Full F] [Faithful F] [EssSurj F] : D ⥤ C
    where
  obj X := F.objPreimage X
  map {X Y} f := F.preimage ((F.objObjPreimageIso X).hom ≫ f ≫ (F.objObjPreimageIso Y).inv)
  map_id X := by apply F.map_injective; aesop_cat
  map_comp {X Y Z} f g := by apply F.map_injective; simp
-- #align category_theory.equivalence.equivalence_inverse CategoryTheory.Equivalence.equivalenceInverse
/- Porting note: this is a private def in mathlib -/

--
/-- A functor which is full, faithful, and essentially surjective is an equivalence.

See <https://stacks.math.columbia.edu/tag/02C3>.
-/
noncomputable def ofFullyFaithfullyEssSurj (F : C ⥤ D) [Full F] [Faithful F] [EssSurj F] :
    IsEquivalence F :=
  IsEquivalence.mk (equivalenceInverse F)
    (NatIso.ofComponents (fun X => (F.preimageIso <| F.objObjPreimageIso <| F.obj X).symm)
      fun f => by
      apply F.map_injective
      aesop_cat)
    (NatIso.ofComponents F.objObjPreimageIso (by aesop_cat))
#align category_theory.equivalence.of_fully_faithfully_ess_surj CategoryTheory.Equivalence.ofFullyFaithfullyEssSurj

@[simp]
theorem functor_map_inj_iff (e : C ≌ D) {X Y : C} (f g : X ⟶ Y) :
    e.functor.map f = e.functor.map g ↔ f = g :=
  ⟨fun h => e.functor.map_injective h, fun h => h ▸ rfl⟩
#align category_theory.equivalence.functor_map_inj_iff CategoryTheory.Equivalence.functor_map_inj_iff

@[simp]
theorem inverse_map_inj_iff (e : C ≌ D) {X Y : D} (f g : X ⟶ Y) :
    e.inverse.map f = e.inverse.map g ↔ f = g :=
  functor_map_inj_iff e.symm f g
#align category_theory.equivalence.inverse_map_inj_iff CategoryTheory.Equivalence.inverse_map_inj_iff

instance essSurjInducedFunctor {C' : Type _} (e : C' ≃ D) : EssSurj (inducedFunctor e) where
  mem_essImage Y := ⟨e.symm Y, by simpa using ⟨default⟩⟩
#align category_theory.equivalence.ess_surj_induced_functor CategoryTheory.Equivalence.essSurjInducedFunctor

noncomputable instance inducedFunctorOfEquiv {C' : Type _} (e : C' ≃ D) :
    IsEquivalence (inducedFunctor e) :=
  Equivalence.ofFullyFaithfullyEssSurj _
#align category_theory.equivalence.induced_functor_of_equiv CategoryTheory.Equivalence.inducedFunctorOfEquiv

noncomputable instance fullyFaithfulToEssImage (F : C ⥤ D) [Full F] [Faithful F] :
    IsEquivalence F.toEssImage :=
  ofFullyFaithfullyEssSurj F.toEssImage
#align category_theory.equivalence.fully_faithful_to_ess_image CategoryTheory.Equivalence.fullyFaithfulToEssImage

end Equivalence

end CategoryTheory


/-
Copyright (c) 2017 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro
-/
import data.nat.lattice
import logic.denumerable
import logic.function.iterate
import order.hom.basic
import tactic.congrm

/-!
# Relation embeddings from the naturals

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

This file allows translation from monotone functions `ℕ → α` to order embeddings `ℕ ↪ α` and
defines the limit value of an eventually-constant sequence.

## Main declarations

* `nat_lt`/`nat_gt`: Make an order embedding `ℕ ↪ α` from an increasing/decreasing function `ℕ → α`.
* `monotonic_sequence_limit`: The limit of an eventually-constant monotone sequence `ℕ →o α`.
* `monotonic_sequence_limit_index`: The index of the first occurence of `monotonic_sequence_limit`
  in the sequence.
-/

variable {α : Type*}

namespace rel_embedding

variables {r : α → α → Prop} [is_strict_order α r]

/-- If `f` is a strictly `r`-increasing sequence, then this returns `f` as an order embedding. -/
def nat_lt (f : ℕ → α) (H : ∀ n : ℕ, r (f n) (f (n + 1))) : ((<) : ℕ → ℕ → Prop) ↪r r :=
of_monotone f $ nat.rel_of_forall_rel_succ_of_lt r H

@[simp] lemma coe_nat_lt {f : ℕ → α} {H : ∀ n : ℕ, r (f n) (f (n + 1))} : ⇑(nat_lt f H) = f := rfl

/-- If `f` is a strictly `r`-decreasing sequence, then this returns `f` as an order embedding. -/
def nat_gt (f : ℕ → α) (H : ∀ n : ℕ, r (f (n + 1)) (f n)) : ((>) : ℕ → ℕ → Prop) ↪r r :=
by { haveI := is_strict_order.swap r, exact rel_embedding.swap (nat_lt f H) }

@[simp] lemma coe_nat_gt {f : ℕ → α} {H : ∀ n : ℕ, r (f (n + 1)) (f n)} : ⇑(nat_gt f H) = f := rfl

theorem exists_not_acc_lt_of_not_acc {a : α} {r} (h : ¬ acc r a) : ∃ b, ¬ acc r b ∧ r b a :=
begin
  contrapose! h,
  refine ⟨_, λ b hr, _⟩,
  by_contra hb,
  exact h b hb hr
end

/-- A value is accessible iff it isn't contained in any infinite decreasing sequence. -/
theorem acc_iff_no_decreasing_seq {x} :
  acc r x ↔ is_empty {f : ((>) : ℕ → ℕ → Prop) ↪r r // x ∈ set.range f} :=
begin
  split,
  { refine λ h, h.rec_on (λ x h IH, _),
    split,
    rintro ⟨f, k, hf⟩,
    exact is_empty.elim' (IH (f (k + 1)) (hf ▸ f.map_rel_iff.2 (lt_add_one k))) ⟨f, _, rfl⟩ },
  { have : ∀ x : {a // ¬ acc r a}, ∃ y : {a // ¬ acc r a}, r y.1 x.1,
    { rintro ⟨x, hx⟩,
      cases exists_not_acc_lt_of_not_acc hx,
      exact ⟨⟨w, h.1⟩, h.2⟩ },
    obtain ⟨f, h⟩ := classical.axiom_of_choice this,
    refine λ E, classical.by_contradiction (λ hx, E.elim'
      ⟨(nat_gt (λ n, (f^[n] ⟨x, hx⟩).1) (λ n, _)), 0, rfl⟩),
    rw function.iterate_succ',
    apply h }
end

theorem not_acc_of_decreasing_seq (f : ((>) : ℕ → ℕ → Prop) ↪r r) (k : ℕ) : ¬ acc r (f k) :=
by { rw [acc_iff_no_decreasing_seq, not_is_empty_iff], exact ⟨⟨f, k, rfl⟩⟩ }

/-- A relation is well-founded iff it doesn't have any infinite decreasing sequence. -/
theorem well_founded_iff_no_descending_seq :
  well_founded r ↔ is_empty (((>) : ℕ → ℕ → Prop) ↪r r) :=
begin
  split,
  { rintro ⟨h⟩,
    exact ⟨λ f, not_acc_of_decreasing_seq f 0 (h _)⟩ },
  { introI h,
    exact ⟨λ x, acc_iff_no_decreasing_seq.2 infer_instance⟩ }
end

theorem not_well_founded_of_decreasing_seq (f : ((>) : ℕ → ℕ → Prop) ↪r r) : ¬ well_founded r :=
by { rw [well_founded_iff_no_descending_seq, not_is_empty_iff], exact ⟨f⟩ }

end rel_embedding

namespace nat
variables (s : set ℕ) [infinite s]

/-- An order embedding from `ℕ` to itself with a specified range -/
def order_embedding_of_set [decidable_pred (∈ s)] : ℕ ↪o ℕ :=
(rel_embedding.order_embedding_of_lt_embedding
  (rel_embedding.nat_lt (nat.subtype.of_nat s) (λ n, nat.subtype.lt_succ_self _))).trans
  (order_embedding.subtype s)

/-- `nat.subtype.of_nat` as an order isomorphism between `ℕ` and an infinite subset. See also
`nat.nth` for a version where the subset may be finite. -/
noncomputable def subtype.order_iso_of_nat : ℕ ≃o s :=
by { classical, exact rel_iso.of_surjective (rel_embedding.order_embedding_of_lt_embedding
  (rel_embedding.nat_lt (nat.subtype.of_nat s) (λ n, nat.subtype.lt_succ_self _)))
  nat.subtype.of_nat_surjective }

variable {s}

@[simp]
lemma coe_order_embedding_of_set [decidable_pred (∈ s)] :
  ⇑(order_embedding_of_set s) = coe ∘ subtype.of_nat s := rfl

lemma order_embedding_of_set_apply [decidable_pred (∈ s)] {n : ℕ} :
  order_embedding_of_set s n = subtype.of_nat s n := rfl

@[simp]
lemma subtype.order_iso_of_nat_apply [decidable_pred (∈ s)] {n : ℕ} :
  subtype.order_iso_of_nat s n = subtype.of_nat s n :=
by { simp [subtype.order_iso_of_nat], congr }

variable (s)

lemma order_embedding_of_set_range [decidable_pred (∈ s)] :
  set.range (nat.order_embedding_of_set s) = s :=
subtype.coe_comp_of_nat_range

theorem exists_subseq_of_forall_mem_union {s t : set α} (e : ℕ → α) (he : ∀ n, e n ∈ s ∪ t) :
  ∃ g : ℕ ↪o ℕ, (∀ n, e (g n) ∈ s) ∨ (∀ n, e (g n) ∈ t) :=
begin
  classical,
  have : infinite (e ⁻¹' s) ∨ infinite (e ⁻¹' t),
    by simp only [set.infinite_coe_iff, ← set.infinite_union, ← set.preimage_union,
      set.eq_univ_of_forall (λ n, set.mem_preimage.2 (he n)), set.infinite_univ],
  casesI this,
  exacts [⟨nat.order_embedding_of_set (e ⁻¹' s), or.inl $ λ n, (nat.subtype.of_nat (e ⁻¹' s) _).2⟩,
    ⟨nat.order_embedding_of_set (e ⁻¹' t), or.inr $ λ n, (nat.subtype.of_nat (e ⁻¹' t) _).2⟩]
end

end nat

theorem exists_increasing_or_nonincreasing_subseq' (r : α → α → Prop) (f : ℕ → α) :
  ∃ (g : ℕ ↪o ℕ), (∀ n : ℕ, r (f (g n)) (f (g (n + 1)))) ∨
    (∀ m n : ℕ, m < n → ¬ r (f (g m)) (f (g n))) :=
begin
  classical,
  let bad : set ℕ := { m | ∀ n, m < n → ¬ r (f m) (f n) },
  by_cases hbad : infinite bad,
  { haveI := hbad,
    refine ⟨nat.order_embedding_of_set bad, or.intro_right _ (λ m n mn, _)⟩,
    have h := set.mem_range_self m,
    rw nat.order_embedding_of_set_range bad at h,
    exact h _ ((order_embedding.lt_iff_lt _).2 mn) },
  { rw [set.infinite_coe_iff, set.infinite, not_not] at hbad,
    obtain ⟨m, hm⟩ : ∃ m, ∀ n, m ≤ n → ¬ n ∈ bad,
    { by_cases he : hbad.to_finset.nonempty,
      { refine ⟨(hbad.to_finset.max' he).succ, λ n hn nbad, nat.not_succ_le_self _
        (hn.trans (hbad.to_finset.le_max' n (hbad.mem_to_finset.2 nbad)))⟩ },
      { exact ⟨0, λ n hn nbad, he ⟨n, hbad.mem_to_finset.2 nbad⟩⟩ } },
    have h : ∀ (n : ℕ), ∃ (n' : ℕ), n < n' ∧ r (f (n + m)) (f (n' + m)),
    { intro n,
      have h := hm _ (le_add_of_nonneg_left n.zero_le),
      simp only [exists_prop, not_not, set.mem_set_of_eq, not_forall] at h,
      obtain ⟨n', hn1, hn2⟩ := h,
      obtain ⟨x, hpos, rfl⟩ := exists_pos_add_of_lt hn1,
      refine ⟨n + x, add_lt_add_left hpos n, _⟩,
      rw [add_assoc, add_comm x m, ← add_assoc],
      exact hn2 },
    let g' : ℕ → ℕ := @nat.rec (λ _, ℕ) m (λ n gn, nat.find (h gn)),
    exact ⟨(rel_embedding.nat_lt (λ n, g' n + m)
      (λ n, nat.add_lt_add_right (nat.find_spec (h (g' n))).1 m)).order_embedding_of_lt_embedding,
      or.intro_left _ (λ n, (nat.find_spec (h (g' n))).2)⟩ }
end

/-- This is the infinitary Erdős–Szekeres theorem, and an important lemma in the usual proof of
    Bolzano-Weierstrass for `ℝ`. -/
theorem exists_increasing_or_nonincreasing_subseq (r : α → α → Prop) [is_trans α r] (f : ℕ → α) :
  ∃ (g : ℕ ↪o ℕ), (∀ m n : ℕ, m < n → r (f (g m)) (f (g n))) ∨
    (∀ m n : ℕ, m < n → ¬ r (f (g m)) (f (g n))) :=
begin
  obtain ⟨g, hr | hnr⟩ := exists_increasing_or_nonincreasing_subseq' r f,
  { refine ⟨g, or.intro_left _ (λ m n mn, _)⟩,
    obtain ⟨x, rfl⟩ := exists_add_of_le (nat.succ_le_iff.2 mn),
    induction x with x ih,
    { apply hr },
    { apply is_trans.trans _ _ _ _ (hr _),
      exact ih (lt_of_lt_of_le m.lt_succ_self (nat.le_add_right _ _)) } },
  { exact ⟨g, or.intro_right _ hnr⟩ }
end

lemma well_founded.monotone_chain_condition' [preorder α] :
  well_founded ((>) : α → α → Prop) ↔ ∀ (a : ℕ →o α), ∃ n, ∀ m, n ≤ m → ¬ a n < a m :=
begin
  refine ⟨λ h a, _, λ h, _⟩,
  { have hne : (set.range a).nonempty := ⟨a 0, by simp⟩,
    obtain ⟨x, ⟨n, rfl⟩, H⟩ := h.has_min _ hne,
    exact ⟨n, λ m hm, H _ (set.mem_range_self _)⟩ },
  { refine rel_embedding.well_founded_iff_no_descending_seq.2 ⟨λ a, _⟩,
    obtain ⟨n, hn⟩ := h (a.swap : ((<) : ℕ → ℕ → Prop) →r ((<) : α → α → Prop)).to_order_hom,
    exact hn n.succ n.lt_succ_self.le ((rel_embedding.map_rel_iff _).2 n.lt_succ_self) },
end

/-- The "monotone chain condition" below is sometimes a convenient form of well foundedness. -/
lemma well_founded.monotone_chain_condition [partial_order α] :
  well_founded ((>) : α → α → Prop) ↔ ∀ (a : ℕ →o α), ∃ n, ∀ m, n ≤ m → a n = a m :=
well_founded.monotone_chain_condition'.trans $ begin
  congrm ∀ a, ∃ n, ∀ m (h : n ≤ m), (_ : Prop),
  rw lt_iff_le_and_ne,
  simp [a.mono h]
end

/-- Given an eventually-constant monotone sequence `a₀ ≤ a₁ ≤ a₂ ≤ ...` in a partially-ordered
type, `monotonic_sequence_limit_index a` is the least natural number `n` for which `aₙ` reaches the
constant value. For sequences that are not eventually constant, `monotonic_sequence_limit_index a`
is defined, but is a junk value. -/
noncomputable def monotonic_sequence_limit_index [preorder α] (a : ℕ →o α) : ℕ :=
Inf {n | ∀ m, n ≤ m → a n = a m}

/-- The constant value of an eventually-constant monotone sequence `a₀ ≤ a₁ ≤ a₂ ≤ ...` in a
partially-ordered type. -/
noncomputable def monotonic_sequence_limit [preorder α] (a : ℕ →o α) :=
a (monotonic_sequence_limit_index a)

lemma well_founded.supr_eq_monotonic_sequence_limit [complete_lattice α]
  (h : well_founded ((>) : α → α → Prop)) (a : ℕ →o α) : supr a = monotonic_sequence_limit a :=
begin
  apply (supr_le (λ m, _)).antisymm (le_supr a _),
  cases le_or_lt m (monotonic_sequence_limit_index a) with hm hm,
  { exact a.monotone hm },
  { cases well_founded.monotone_chain_condition'.1 h a with n hn,
    exact (nat.Inf_mem ⟨n, λ k hk, (a.mono hk).eq_of_not_lt (hn k hk)⟩ m hm.le).ge }
end


-- noncomputable

section Category
class Quiver where
    ob  : Type u
    hom : ob → ob → Type v

class PreCategory extends Quiver where
    id    : (X : ob) → (hom X X)
    comp  : (hom X Y) → (hom Y Z) → (hom X Z)

infixr:80 " ○ " => PreCategory.comp

class Category extends PreCategory where
    id_comp : (f : hom X Y) → ((id X) ○ f) = f
    comp_id : (f : hom X Y) → (f ○ (id Y)) = f
    assoc   : ∀ {X Y Z W : ob} (f : hom W X) (g : hom X Y) (h : hom Y Z),
                (f ○ g) ○ h = f ○ (g ○ h)
instance : CoeSort Category (Type u) where
    coe c := c.ob

class CategoryObjIso {C : Category} (X Y : C) where
    hom : C.hom X Y
    inv : C.hom Y X
    hom_inv_id  : hom ○ inv = C.id X
    inv_hom_id  : inv ○ hom = C.id Y
instance {C : Category} {X Y : C.ob} : CoeSort (CategoryObjIso X Y) (C.hom X Y) where
    coe c := c.hom
def HomIsObjIso {C : Category} {X Y : C} (f : C.hom X Y) :=
    ∃ (h : CategoryObjIso X Y), h.hom = f

infix:80 " =ob= " => CategoryObjIso

end Category

section Func
class PreFunc (C : Quiver) (D : Quiver) :=
    ob_map  : C.ob → D.ob
    hom_map : ∀{X Y : C.ob},(C.hom X Y) → (D.hom (ob_map X) (ob_map Y))
class Func (C : Category) (D : Category)
    extends PreFunc (C.toQuiver : Quiver) (D.toQuiver : Quiver) where
    map_id      : ∀ (X : C), hom_map (C.id X) = D.id (ob_map X)
    map_comp    : ∀ {X Y Z : C} (f : C.hom X Y) (g : C.hom Y Z),
                    hom_map (C.comp f g) = D.comp (hom_map f) (hom_map g)
instance : CoeSort (Func C D) (C.ob → D.ob) where
    coe X := X.ob_map
def Func_id (C : Category) : Func C C where
    ob_map      := fun X => X
    hom_map     := fun f => f
    map_id      := fun _ => rfl
    map_comp    := fun _ _ => rfl

def Func_comp {C : Category} {D : Category} {E : Category} (F : Func C D) (G : Func D E) : Func C E where
    ob_map      := G.ob_map ∘ F.ob_map
    hom_map     := G.hom_map ∘ F.hom_map;
    map_id      := by {
        intro X;
        have : (G.hom_map ∘ F.hom_map) (C.id X) = E.id ((G.ob_map ∘ F.ob_map) X) := by {
            have : E.id (G.ob_map (F.ob_map X)) = E.id (Function.comp G.ob_map F.ob_map X) := rfl;
            rw [Function.comp, F.map_id, G.map_id, this];
        };
        exact this;
    }
    map_comp    := by {
        intro X Y Z f g;
        have : (G.hom_map ∘ F.hom_map) (C.comp f g) = E.comp ((G.hom_map ∘ F.hom_map) f) ((G.hom_map ∘ F.hom_map) g) := by {
            rw [Function.comp, F.map_comp, G.map_comp, Function.comp, Function.comp];
        };
        exact this;
    }

class CategoryIso (C : Category) (D : Category) where
    to_func     : Func C D
    inv_func    : Func D C
    to_inv_id   : (Func_comp F G) = Func_id C
    inv_to_id   : (Func_comp G F) = Func_id D

end Func

section NatTrans

class NatTrans {C : Category} {D : Category} (F G : Func C D) where
    to_func : ∀ (X : C), D.hom (F.ob_map X) (G.ob_map X)
    comm    : ∀ (X Y : C.ob) (f : C.hom X Y),
                    D.comp (to_func X) (G.hom_map f) = D.comp (F.hom_map f) (to_func Y)

def NatTrans_id {C : Category} {D : Category} (F : Func C D) : NatTrans F F where
    to_func := fun X => D.id (F.ob_map X);
    comm    := by {
        intro X Y f;
        have h1 :
                D.comp ((fun X => D.id (F.ob_map X)) X) (F.hom_map f)
            =   D.comp (D.id (F.ob_map X)) (F.hom_map f) := by rfl;
        have h2 :
                D.comp (F.hom_map f) ((fun X => D.id (F.ob_map X)) Y)
            =   D.comp (F.hom_map f) (D.id (F.ob_map Y)) := by rfl;
        have h3 : D.comp (D.id (F.ob_map X)) (F.hom_map f) = (F.hom_map f) := D.id_comp (F.hom_map f);
        have h4 : (F.hom_map f) = D.comp (F.hom_map f) (D.id (F.ob_map Y)) := (D.comp_id (F.hom_map f)).symm;
        rw [h1, h2, h3];
        exact h4;
    }

def NatTrans_comp {C : Category} {D : Category} {F G H : Func C D}
        (α : NatTrans F G) (β : NatTrans G H)  : NatTrans F H where
    to_func := fun X => D.comp (α.to_func X) (β.to_func X)
    comm    := by {
        intro X Y f;
        have h1 (Z : C) :
                ((fun X => D.comp (α.to_func X) (β.to_func X)) Z)
            =   (D.comp (α.to_func Z) (β.to_func Z)) := by rfl;
        rw [h1,
            h1,
            D.assoc,
            β.comm,
            (D.assoc _ _ _).symm,
            α.comm,
            D.assoc];
    }

end NatTrans

section FuncCategory

def NatTrans_id_comp : ∀ {C : Category} {D : Category} {F G : Func C D} (α : NatTrans F G),
    NatTrans_comp (NatTrans_id F) α = α := by {
        intro C D F G α;
        have : ∀ (X : C), D.comp ((NatTrans_id F).to_func X) (α.to_func X) = (α.to_func X) := by {
            intro X;
            sorry;
        };
        -- exact ⟨this, True⟩;
        -- have := (fun X => NatTrans.to_func X) ○ G.to_func X;
        sorry;
    }
def NatTrans_comp_id : ∀ {C : Category} {D : Category} {F G : Func C D} (α : NatTrans F G),
    NatTrans_comp α (NatTrans_id G) = α := by {intro C D F G α; sorry;}
def NatTrans_assoc : ∀ {C : Category} {D : Category} {F G H I : Func C D}
    (α : NatTrans F G) (β : NatTrans G H) (γ : NatTrans H I),
    NatTrans_comp (NatTrans_comp α β) γ = NatTrans_comp α (NatTrans_comp β γ) := by sorry

def FuncCategory (C : Category) (D : Category) : Category where
    ob      := Func C D
    hom     := NatTrans
    id      := NatTrans_id
    comp    := NatTrans_comp
    id_comp := NatTrans_id_comp
    comp_id := NatTrans_comp_id
    assoc   := NatTrans_assoc

end FuncCategory

section Opposite
def opposite (C : Category) : Category where
    ob      := C.ob
    hom     := fun A B => C.hom B A
    id      := C.id
    comp    := fun f g => C.comp g f
    id_comp := C.comp_id
    comp_id := C.id_comp
    assoc   := fun f g h => (C.assoc h g f).symm

notation C "ᵒᵖ" => opposite C
end Opposite

section SimplexCategory
def monotone (f : α → β) [LE α] [LE β] : Prop := ∀ a b : α, a ≤ b → f a ≤ f b

def simplex_hom (n m : Nat) := {f : Fin n → Fin m // monotone f}

theorem id_is_monotone : monotone (fun (x : Fin n) => x) :=
    fun _ _ h => h
theorem comp_is_monotone {n m k : Nat} (f : simplex_hom n m) (g : simplex_hom m k) : monotone (g.val ∘ f.val) :=
    fun a b h => g.property (f.val a) (f.val b) (f.property a b h)

def SimplexCategory : Category where
    ob      := Nat
    hom {n m : Nat} := simplex_hom n m
    id      := fun _ => ⟨fun x => x, id_is_monotone⟩
    comp    := by {
        intro X Y Z f g;
        exact ⟨g.val ∘ f.val, comp_is_monotone f g⟩;
    }
    id_comp := by {intro _ _ _; rfl;}
    comp_id := by {intro _ _ _; rfl;}
    assoc   := by {intro _ _ _ _ _ _ _; rfl;}
instance : OfNat SimplexCategory n where
    ofNat := n

def SimplexCategoryOp : Category := SimplexCategoryᵒᵖ
instance : OfNat SimplexCategoryOp n where
    ofNat := n

end SimplexCategory

section SimplicialObject
def SimplicialObject (C : Category) :=
    Func (SimplexCategoryᵒᵖ) C
end SimplicialObject

section SetCategory

def SetCategory.{u} : Category where
    ob      := Type u
    hom     := fun (A B : Type u) => (A → B)
    id      := fun (A : Type u) => (fun (x : A) => x)
    comp    := fun {A B C : Type u} (f : A → B) (g : B → C) => g ∘ f
    id_comp := fun _ => rfl
    comp_id := fun _ => rfl
    assoc   := fun _ _ _ => rfl
end SetCategory

section SimplicialSet
def yoneda (C : Category) : Category :=
    FuncCategory C (FuncCategory (Cᵒᵖ) SetCategory)
def SSet.{u} := FuncCategory (SimplexCategoryᵒᵖ) SetCategory.{u}
def StandardSimplexCategory := yoneda SSet

def StandardSimplex (n : Nat) : SSet where
    ob_map      := fun m => (simplex_hom m n)
    hom_map     := by {
        intro m k f;
        exact fun σ => ⟨σ.val ∘ f.val , comp_is_monotone f σ⟩;
    }
    map_id      := by {intro _; rfl;}
    map_comp    := by {intro _ _ _ _ _; rfl;}

instance : OfNat SSet n where
  ofNat := StandardSimplex n
local notation "Δ["n"]" => StandardSimplex n

end SimplicialSet


import ring_theory.matrix
import data.rat
import data.set data.set.enumerate data.set.finite data.finset
import set_theory.cardinal
import tactic.linarith

variables {α : Type} {n m l s t : Type} [fintype n] [fintype m] [fintype s] [fintype t]

variables {n1 n2 : nat}

section matrix
def le [partial_order α] (M N : matrix n m α)  :=
∀i:n, ∀j:m, M i j ≤ N i j

instance [partial_order α] : has_le (matrix n m α) :=
{ le := le }

protected lemma matrix.le_refl [partial_order α] (A: matrix n m α) :
A ≤ A :=
by intros i j; refl

protected lemma matrix.le_trans [partial_order α] (a b c: matrix n m α)
  (h1 : a ≤ b) (h2 : b ≤ c) : a ≤ c :=
by intros i j; transitivity; solve_by_elim

protected lemma matrix.le_antisymm [partial_order α] (a b: matrix n m α)
  (h1 : a ≤ b) (h2 : b ≤ a) : a = b :=
by ext i j; exact le_antisymm (h1 i j) (h2 i j)

instance [partial_order α] : partial_order (matrix n m α) :=
{
  le := le,
  le_refl := matrix.le_refl,
  le_trans := matrix.le_trans,
  le_antisymm := matrix.le_antisymm
}

end matrix

local infixl ` *ₘ ` : 70 := matrix.mul

def polyhedron [ordered_ring α] (A : matrix m n α) (b : matrix m unit α) :
  set (matrix n unit α) :=
{ x : matrix n unit α | A *ₘ x ≥ b }

def vec (n: Type) (α : Type) [fintype n] :=
n → α

instance [ordered_ring α] [decidable_rel ((≤) : α → α → Prop)]
  (A : matrix m n α) (b : matrix m unit α) (x : matrix n unit α) :
  decidable (x ∈ polyhedron A b) :=
show decidable (∀i:m, ∀j:unit, b i j ≤ (A *ₘ x) i j),
  by apply_instance

variables [ordered_ring α] (A B : matrix m n α) (b : matrix m unit α)

protected def matrix.row (A : matrix m n α) (row : m) : matrix unit n α :=
λ x: unit, λ y: n, (A row) y

lemma polyhedron_rowinE [ordered_ring α]
        (x: matrix n unit α) (A: matrix m n α) (b: matrix m unit α):
    x ∈ (polyhedron A b) = ∀ i:m, (matrix.row A i *ₘ x) () () ≥ b i () :=

propext $ iff.intro
  (assume h: x ∈ (polyhedron A b),
   assume d: m,
   show (matrix.row A d *ₘ x) () () ≥ b d (),
   begin
     rw polyhedron at h,
     rw set.mem_set_of_eq at h,
     exact h d ()
   end
  )
  (assume h: ∀ i:m, (matrix.row A i *ₘ x) () () ≥ b i (),
   show x ∈ (polyhedron A b),
   begin
   assume d : m,
   assume j : unit,
   rw <-(≥),
   cases j,
   apply h,
   end
  )

def active_ineq [ordered_ring α] (x: matrix n unit α)
    (A: matrix m n α) (b: matrix m unit α) : set m :=
{ i | ((A *ₘ x) i () == b i ())}

def pick_encodable (α : Type) (p : α → Prop) [decidable_pred p]:
Π (m n), matrix (fin m) (fin n) α → option(fin m × fin n)
| x y V :=
  if h : ∃ (ij : fin x × fin y), p (V ij.1 ij.2)
    then let idx := encodable.choose h in
      some idx
    else
      none

def fin_prefix {n} (i : fin n) (k: nat) : fin (n + k) :=
⟨i.1,
begin
  have h : i.val < n, from by apply i.2,
  apply lt_add_of_lt_of_nonneg,
  apply h,
  have h2 : n = 0 ∨ n > 0, from by apply nat.eq_zero_or_pos,
  simp
end
⟩

def fin_first {n m} (i : fin (n + m)) (h : i.val < n): fin (n) :=
⟨i.1, begin apply h end⟩

def fin_second {n m} (i : fin (n + m)) (h: i.val >= n ): fin (m) :=
⟨i.1 - n,
  begin
    have h2: i.val < n + m, from i.2,
    sorry
  end
⟩

variables {m' n': Type} [fintype m'] [fintype n']

def nat_add {n} (k) (i : fin n) : fin (k + n) :=
⟨k + i.1, nat.add_lt_add_left i.2 _⟩

def xrow [decidable_eq m] (row1: m) (row2: m) (A: matrix m n α) : matrix m n α :=
λ x y, if x = row1
         then
           A row2 y
         else
           if x = row2
             then
               A row1 y
             else
               A x y

def xcol [decidable_eq n] (col1: n) (col2: n) (A: matrix m n α) : matrix m n α :=
λ x y, if y = col1
         then
           A x col2
         else
           if y = col2
             then
               A x col1
             else
               A x y

def minormx
  (A: matrix m n α)
  (trans_col: (m' → m))
  (trans_row: (n' → n)) :
  matrix m' n' α :=
λ i j, A (trans_col i) (trans_row j)

def rsubmx {m n_left n_right: nat}
  (A : matrix (fin m) (fin (n_left + n_right)) α) :
  matrix (fin m) (fin (n_right)) α :=
minormx A (λ i, i) (λ j, nat_add n_left j)

def lsubmx {m n_left n_right: nat}
  (A: matrix (fin m) (fin (n_left + n_right)) α):
  matrix (fin m) (fin (n_left)) α :=
minormx A (λ i, i) (λ j, fin_prefix j n_right)

def usubmx {m_down m_up n: nat}
  (A: matrix (fin (m_up + m_down)) (fin n) α) :
  matrix (fin m_up) (fin n) α :=
minormx A (λ i, fin_prefix i m_down) (λ j, j)

def dsubmx {m_down m_up n: nat}
  (A: matrix (fin (m_up + m_down)) (fin n) α) :
  matrix (fin m_down) (fin n) α :=
minormx A (λ i, nat_add m_up i) (λ j, j)

def ursubmx {m_down m_up n_left n_right: nat}
  (A: matrix (fin (m_up + m_down)) (fin (n_left + n_right)) α) :
  matrix (fin m_up) (fin (n_right)) α :=
usubmx (rsubmx A)

def drsubmx {m_down m_up n_left n_right: nat}
  (A: matrix (fin (m_up + m_down)) (fin (n_left + n_right)) α) :
  matrix (fin m_down) (fin (n_right)) α :=
dsubmx (rsubmx A)

def ulsubmx {m_down m_up n_left n_right: nat}
  (A: matrix (fin (m_up + m_down)) (fin (n_left + n_right)) α) :
  matrix (fin m_up) (fin (n_left)) α :=
usubmx (lsubmx A)

def dlsubmx {m_down m_up n_left n_right: nat}
  (A: matrix (fin (m_up + m_down)) (fin (n_left + n_right)) α) :
  matrix (fin m_down) (fin (n_left)) α :=
dsubmx (lsubmx A)

def fin_swap {m m' n n' : nat}
  (A: matrix (fin (m + m')) (fin (n + n')) α) :
   matrix (fin (m' + m)) (fin (n' + n)) α :=
minormx A fin_swap_add fin_swap_add

def block_mx {m_down m_up n_left n_right: nat} :
  matrix (fin m_up) (fin n_left) α →
  matrix (fin m_up) (fin n_right) α →
  matrix (fin m_down) (fin n_left) α →
  matrix (fin m_down) (fin n_right) α →
  matrix (fin (m_up + m_down)) (fin (n_left + n_right)) α
| up_left up_right down_left down_right :=
λ i j,
 if h_i: i.val < m_up
 then
    if h_j: j.val < n_left
    then
      up_left (fin_first i (by assumption)) (fin_first j (by assumption))
    else
      up_right (fin_first i (by assumption)) (fin_second j (by apply le_of_not_gt; assumption))
  else
   if h_j: j.val < n_left
    then
      down_left (fin_second i (by apply le_of_not_gt; assumption)) (fin_first j (by assumption))
    else
      down_right (fin_second i (by apply le_of_not_gt; assumption)) (fin_second j (by apply le_of_not_gt; assumption))

def Gaussian_elimination [decidable_eq α] [has_inv α]:
   Π (m n), matrix (fin m) (fin n) α →
   (matrix (fin m) (fin m) α × matrix (fin n) (fin n) α × nat)
| (x+1) (y+1) A :=
  let optional_ij := pick_encodable (α) (λ el, el ≠ 0) (x+1) (y+1) A in
  match optional_ij with
  | some ij :=
    let i := ij.1 in
    let j := ij.2 in
    let a := A i j in
    let A1 := xrow i 0 (xcol j 0 A) in
    let A1' := fin_swap A1 in
    let B := A1' in
    let u := ursubmx A1' in
    let v := a⁻¹ • dlsubmx A1' in
    let (L, U, r) := Gaussian_elimination (x) (y) (drsubmx A1' - (v *ₘ u)) in
    (
      xrow i 0 (fin_swap (block_mx 1 0 v L)),
      xcol j 0 (fin_swap (block_mx (λ i1 j1, a) u 0 U)),
      r + 1
    )
  | none :=
     (
      (1 : (matrix (fin (x+1)) (fin (x+1)) α)),
      (1 : (matrix (fin (y+1)) (fin (y+1)) α)),
      0
     )
  end
| x y A :=
     (
      (1 : (matrix (fin (x)) (fin (x)) α)),
      (1 : (matrix (fin (y)) (fin (y)) α)),
      0
     )

def test : matrix (fin 3) (fin 3) rat :=
λ x y,
if (x = 0 ∧ y = 0) then 3 else
if (x = 0 ∧ y = 1) then 3 else
if (x = 0 ∧ y = 2) then 3 else
if (x = 1 ∧ y = 0) then 3 else
if (x = 1 ∧ y = 1) then 2 else
if (x = 1 ∧ y = 2) then 3 else
if (x = 2 ∧ y = 0) then 2 else
if (x = 2 ∧ y = 1) then 1 else
if (x = 2 ∧ y = 2) then 1 else
0

def getL [decidable_eq α] [has_inv α] {m n : nat}  (M : matrix (fin n) (fin m) α) :=
  let res := Gaussian_elimination n m M in
  res.1

def getU [decidable_eq α] [has_inv α] {m n : nat}  (M : matrix (fin n) (fin m) α) :=
  let res := Gaussian_elimination n m M in
  res.2.1

def getRank [decidable_eq α] [has_inv α] (m n : nat)  (M : matrix (fin n) (fin m) α) :=
  let res := Gaussian_elimination n m M in
  res.2.2

theorem L_times_U_is_input [decidable_eq α] [has_inv α] [has_one α] (m n : nat)
   (M : matrix (fin m) (fin m) α) : (getL M) *ₘ (getU M) = M :=
begin
  rw getL,
  rw getU,
  simp,
  induction m,
  rw Gaussian_elimination,
  simp,
  rw (*ₘ),
  rw

  rw Gaussian_elimination,
  simp,

end


import tactic.norm_cast
import data.int.cast

set_option pp.numerals false
set_option pp.notation false
-- set_option trace.simplify.rewrite true

run_cmd norm_cast.numeral_to_coe `(0 : ℤ)
run_cmd norm_cast.numeral_to_coe `(1 : ℤ)
run_cmd norm_cast.numeral_to_coe `(2 : ℤ)
run_cmd norm_cast.numeral_to_coe `(3 : ℤ)

run_cmd norm_cast.coe_to_numeral `((0 : ℕ) : ℤ)
run_cmd norm_cast.coe_to_numeral `((1 : ℕ) : ℤ)
run_cmd norm_cast.coe_to_numeral `((2 : ℕ) : ℤ)
run_cmd norm_cast.coe_to_numeral `((3 : ℕ) : ℤ)

example : ((42 : ℕ) : ℤ) = 42 := by norm_cast


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

open matrix fintype finset function pequiv is_tableau

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

variables {m n : ℕ}
variables {X : ℕ → ℕ → Type} [is_tableau X]

namespace is_tableau
open partition

section predicates

variable (T : X m n)

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

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

/-- The dead_set is the subset of ℚ^(m+n) such that all dead variables are zero, and satisfies
  the affine conditions -/
def dead_set : set (cvec (m + n)) :=
flat T ∩ { x | ∀ j, j ∈ (dead T) → x ((to_partition T).colg j) 0 = 0 }

/-- The `sol_set` is the set of vector that satisfy the affine constraints the dead variable
  constraints, and the nonnegativity constraints. -/
def sol_set : set (cvec (m + n)) :=
res_set T ∩ { x | ∀ j, j ∈ (dead T) → x ((to_partition T).colg j) 0 = 0 }

lemma sol_set_eq_res_set_inter :
  (sol_set T) = res_set T ∩ { x | ∀ j, j ∈ (dead T) → x ((to_partition T).colg j) 0 = 0 } := rfl

lemma sol_set_eq_dead_set_inter :
   (sol_set T) = dead_set T ∩ { x | ∀ i, i ∈ (restricted T) → 0 ≤ x i 0 } :=
set.inter_right_comm _ _ _

lemma sol_set_eq_res_set_inter_dead_set : (sol_set T) = (res_set T) ∩ (dead_set T) :=
by simp [sol_set, res_set, dead_set, set.ext_iff]; tauto

/-- Predicate for a variable being unbounded above in the `res_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 `res_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_optimal (x : cvec (m + n)) (i : fin (m + n)) : Prop :=
x ∈ (sol_set T) ∧ ∀ y : cvec (m + n), y ∈ sol_set T → y i 0 ≤ x i 0

/-- Is this equivalent to `∀ (x : cvec (m + n)), x ∈ res_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 : X m n) (x : cvec n) : cvec (m + n) :=
(to_partition T).colp.to_matrix ⬝ x + (to_partition T).rowp.to_matrix ⬝ ((to_matrix T) ⬝ x + (const T))

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

instance : decidable_pred (@feasible m n X _) := λ _, by dunfold feasible; apply_instance

end predicates

section predicate_lemmas
variable {T : X m n}

-- @[simp] lemma eta : tableau.mk (to_partition T) (to_matrix T) (const T) (restricted T) (dead T) = T :=
-- by cases T; refl

lemma mem_flat_iff {x : cvec (m + n)} : x ∈ (flat T) ↔
  ∀ r, x ((to_partition T).rowg r) 0 = univ.sum
    (λ c : fin n, (to_matrix T) r c * x ((to_partition T).colg c) 0) +
  (const T) r 0 :=
have hx : x ∈ (flat T) ↔ ∀ i, ((to_partition T).rowp.to_matrixᵀ ⬝ x) i 0 =
    ((to_matrix T) ⬝ (to_partition T).colp.to_matrixᵀ ⬝ x + (const T)) 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 [← to_matrix_symm, mul_matrix_apply, add_val, rowp_symm_eq_some_rowg,
    matrix.mul_assoc, matrix.mul],
  conv in ((to_matrix T) _ _ * ((to_partition T).colp.to_matrixᵀ ⬝ x) _ _)
  { rw [← to_matrix_symm, mul_matrix_apply, colp_symm_eq_some_colg] }
end

variable (T)

@[simp] lemma colp_mul_of_col (x : cvec n) :
  (to_partition T).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_transpose_mul_colp _),
    mul_right_eq_of_mul_eq (rowp_transpose_mul_rowp _),
    mul_right_eq_of_mul_eq (colp_transpose_mul_colp _),
    mul_right_eq_of_mul_eq (colp_transpose_mul_rowp _)]

@[simp] lemma rowp_mul_of_col (x : cvec n) :
  (to_partition T).rowp.to_matrixᵀ ⬝ of_col T x = (to_matrix T) ⬝ x + (const T) :=
by simp [matrix.mul_assoc, matrix.mul_add, of_col, flat,
    mul_right_eq_of_mul_eq (rowp_transpose_mul_colp _),
    mul_right_eq_of_mul_eq (rowp_transpose_mul_rowp _),
    mul_right_eq_of_mul_eq (colp_transpose_mul_colp _),
    mul_right_eq_of_mul_eq (colp_transpose_mul_rowp _)]

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

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

lemma of_col_rowg (c : cvec n) (r : fin m) :
  of_col T c ((to_partition T).rowg r) = ((to_matrix T) ⬝ c + (const T)) r :=
funext $ λ v,
  calc of_col T c ((to_partition T).rowg r) v =
      ((to_partition T).rowp.to_matrixᵀ ⬝ of_col T c) r v :
     by rw [← to_matrix_symm, mul_matrix_apply, rowp_symm_eq_some_rowg]
  ... = ((to_matrix T) ⬝ c + (const T)) r v : by rw [rowp_mul_of_col]

variable {T}

lemma of_col_single_rowg {q : ℚ} {r c} {k} :
  (of_col T) (q • (single c 0).to_matrix) ((to_partition T).rowg r) k =
    q * (to_matrix T) r c + (const T) r k:=
begin
  fin_cases k,
  erw [of_col_rowg, matrix.mul_smul, matrix.add_val, matrix.smul_val,
    matrix_mul_apply, pequiv.symm_single_apply]
end

/-- Condition for the solution given by setting column index `j` to `q` and all other columns to
  zero being in the `res_set` -/
lemma of_col_single_mem_res_set {q : ℚ} {c : fin n} (hT : (feasible T))
  (hi : ∀ i, (to_partition T).rowg i ∈ (restricted T) → 0 ≤ q * (to_matrix T) i c)
  (hj : (to_partition T).colg c ∉ (restricted T) ∨ 0 ≤ q) :
  (of_col T) (q • (single c 0).to_matrix) ∈ (res_set T) :=
⟨of_col_mem_flat _ _,
  λ v, ((to_partition T).eq_rowg_or_colg v).elim
    begin
      rintros ⟨r, hr⟩ hres,
      subst hr,
      rw [of_col_single_rowg],
      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 of_col_single_mem_sol_set {q : ℚ} {c : fin n} (hT : (feasible T))
  (hi : ∀ i, (to_partition T).rowg i ∈ (restricted T) → 0 ≤ q * (to_matrix T) i c)
  (hj : (to_partition T).colg c ∉ (restricted T) ∨ 0 ≤ q) (hdead : c ∉ (dead T) ∨ q = 0):
  (of_col T) (q • (single c 0).to_matrix) ∈ (sol_set T) :=
⟨of_col_single_mem_res_set hT hi hj,
  λ j hj, classical.by_cases
    (λ hjc : j = c, by subst hjc; simp * at *)
    (λ hjc : j ≠ c, by simp [smul_val, pequiv.single, pequiv.to_matrix, hjc])⟩

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

@[simp] lemma of_col_zero_mem_sol_set_iff : (of_col T) 0 ∈ (sol_set T) ↔ (feasible T) :=
by simp [sol_set,  of_col_zero_mem_res_set_iff]

lemma is_unbounded_above_colg_aux {c : fin n} (hT : (feasible T)) (hdead : c ∉ (dead T))
  (h : ∀ i : fin m, (to_partition T).rowg i ∈ (restricted T) → 0 ≤ (to_matrix T) 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) ((to_partition T).colg c) 0 :=
⟨of_col_single_mem_sol_set hT (λ i hi, mul_nonneg (le_max_right _ _) (h _ hi))
    (or.inr (le_max_right _ _)) (or.inl hdead),
  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 : (feasible T)) (hdead : c ∉ (dead T))
  (h : ∀ i : fin m, (to_partition T).rowg i ∈ (restricted T) → 0 ≤ (to_matrix T) i c) :
  (is_unbounded_above T) ((to_partition T).colg c) :=
λ q, ⟨_, is_unbounded_above_colg_aux hT hdead h q⟩

lemma is_unbounded_below_colg_aux {c : fin n} (hT : (feasible T))
  (hres : (to_partition T).colg c ∉ (restricted T)) (hdead : c ∉ (dead T))
  (h : ∀ i : fin m, (to_partition T).rowg i ∈ (restricted T) → (to_matrix T) 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) ((to_partition T).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) (or.inl hdead),
  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 : (feasible T))
  (hres : (to_partition T).colg c ∉ (restricted T)) (hdead : c ∉ (dead T))
  (h : ∀ i : fin m, (to_partition T).rowg i ∈ (restricted T) → (to_matrix T) i c ≤ 0) :
  (is_unbounded_below T) ((to_partition T).colg c) :=
λ q, ⟨_, is_unbounded_below_colg_aux hT hres hdead 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 : (feasible T)) (c : fin n)
  (hres : (to_partition T).colg c ∉ (restricted T)) (hdead : c ∉ (dead T))
  (h : ∀ i : fin m, (to_partition T).rowg i ∈ (restricted T) → (to_matrix T) i c ≤ 0)
  (his : (to_matrix T) r c < 0) : is_unbounded_above T ((to_partition T).rowg r) :=
λ q, ⟨(of_col T) (min ((q - (const T) r 0) / (to_matrix T) r c) 0 • (single c 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) (or.inl hdead),
  begin
    rw [of_col_rowg, add_val, matrix.mul_smul, smul_val, matrix_mul_apply,
      symm_single_apply],
    cases le_total 0 ((q - (const T) r 0) / (to_matrix T) r c) 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 : (feasible T)) (c : fin n)
  (hs : ∀ i : fin m, (to_partition T).rowg i ∈ (restricted T) → 0 ≤ (to_matrix T) i c) (hdead : c ∉ (dead T))
  (his : 0 < (to_matrix T) r c) : is_unbounded_above T ((to_partition T).rowg r) :=
λ q, ⟨(of_col T) (max ((q - (const T) r 0) / (to_matrix T) r c) 0 • (single c 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 _ _)) (or.inl hdead),
  begin
    rw [of_col_rowg, add_val, matrix.mul_smul, smul_val, matrix_mul_apply,
      symm_single_apply],
    cases le_total ((q - (const T) r 0) / (to_matrix T) r c) 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_optimal_of_col_zero {obj : fin m} (hf : (feasible T))
  (h : ∀ j, j ∉ (dead T) → (to_matrix T) obj j ≤ 0 ∧
    ((to_partition T).colg j ∉ (restricted T) → (to_matrix T) obj j = 0)) :
  (is_optimal T) ((of_col T) 0) ((to_partition T).rowg obj) :=
⟨of_col_zero_mem_sol_set_iff.2 hf, λ x hx, begin
  rw [of_col_rowg, matrix.mul_zero, zero_add, mem_flat_iff.1 hx.1.1],
  refine add_le_of_nonpos_of_le _ (le_refl _),
  refine sum_nonpos (λ j _, _),
  by_cases hj : ((to_partition T).colg j) ∈ (restricted T),
  { by_cases hdead : j ∈ (dead T),
    { simp [hx.2 _ hdead] },
    { exact mul_nonpos_of_nonpos_of_nonneg (h _ hdead).1 (hx.1.2 _ hj) } },
  { by_cases hdead : j ∈ (dead T),
    { simp [hx.2 _ hdead] },
    { rw [(h _ hdead).2 hj, zero_mul] } }
end⟩

lemma not_optimal_of_unbounded_above {v : fin (m + n)} {x : cvec (m + n)}
  (hu : is_unbounded_above T v) : ¬is_optimal T x v :=
λ hm, let ⟨y, hy⟩ := hu (x v 0 + 1) in
  not_le_of_gt (lt_add_one (x v 0)) (le_trans hy.2 (hm.2 y hy.1))

/-- 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 ∈ (flat T)) {r : fin m} {s : fin n} :
  (univ.erase s).sum (λ j : fin n, (to_matrix T) r j * x ((to_partition T).colg j) 0) =
    x ((to_partition T).rowg r) 0 - (const T) r 0 - (to_matrix T) r s * x ((to_partition T).colg 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 ∈ (flat T)) {r : fin m} {s : fin n}
  (hrs : (to_matrix T) r s ≠ 0) : x ((to_partition T).colg s) 0 =
    (x ((to_partition T).rowg r) 0
    -(univ.erase s).sum (λ j : fin n, (to_matrix T) r j * x ((to_partition T).colg j) 0)
        - (const T) r 0) * ((to_matrix T) r s)⁻¹ :=
by simp [row_sum_erase_eq hx, mul_left_comm ((to_matrix T) r s)⁻¹, mul_assoc,
    mul_left_comm ((to_matrix T) 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 ∈ (flat T)) {r : fin m} {s : fin n}
  (hrs : (to_matrix T) r s ≠ 0) : x ((to_partition T).colg s) 0 =
  univ.sum (λ (j : fin n), (if j = s then ((to_matrix T) r s)⁻¹
    else (-((to_matrix T) r j * ((to_matrix T) r s)⁻¹))) *
      x (colg (swap ((to_partition T)) r s) j) 0) -
  ((const T) r 0) * ((to_matrix T) r s)⁻¹ :=
have (univ.erase s).sum
    (λ j : fin n, ite (j = s) ((to_matrix T) r s)⁻¹ (-((to_matrix T) r j * ((to_matrix T) r s)⁻¹)) *
      x (colg (swap ((to_partition T)) r s) j) 0) =
    (univ.erase s).sum (λ j : fin n,
      -(to_matrix T) r j * x ((to_partition T).colg j) 0 * ((to_matrix T) 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 : (to_matrix T) r s ≠ 0) :
--   pivot ((pivot T) r s) 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

variable (T)

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

@[simp] lemma pivot_pivot_row {r : fin m} {j s : fin n} (h : j ≠ s) :
  to_matrix ((pivot T) r s) r j = -(to_matrix T) r j / (to_matrix T) r s :=
by simp [to_matrix, to_tableau_pivot, tableau.pivot_pivot_row _ h]

@[simp] lemma pivot_pivot_column {i r : fin m} {s : fin n} (h : i ≠ r) :
  to_matrix ((pivot T) r s) i s = (to_matrix T) i s / (to_matrix T) r s :=
by simp [to_matrix, to_tableau_pivot, tableau.pivot_pivot_column _ h]

@[simp] lemma pivot_of_ne_of_ne {i r : fin m} {j s : fin n} (hir : i ≠ r)
  (hjs : j ≠ s) : to_matrix ((pivot T) r s) i j =
  (to_matrix T) i j - (to_matrix T) i s * (to_matrix T) r j / (to_matrix T) r s :=
by simp [to_matrix, to_tableau_pivot, tableau.pivot_of_ne_of_ne _ hir hjs]

@[simp] lemma const_pivot_row {r : fin m} {s : fin n} : const ((pivot T) r s) r 0 =
  -(const T) r 0 / (to_matrix T) r s :=
by simp [const, to_matrix, to_tableau_pivot, tableau.const_pivot_row]

@[simp] lemma const_pivot_of_ne {i r : fin m} {s : fin n} (hir : i ≠ r) : const ((pivot T) r s) i 0
  = (const T) i 0 - (to_matrix T) i s * (const T) r 0 / (to_matrix T) r s :=
by simp [const, to_matrix, to_tableau_pivot, tableau.const_pivot_of_ne _ hir]

@[simp] lemma restricted_pivot (r s) : restricted ((pivot T) r s) = (restricted T) :=
by simp [restricted, to_tableau_pivot]

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

@[simp] lemma dead_pivot (r c) : dead ((pivot T) r c) = (dead T) :=
by simp [dead, to_tableau_pivot]

variable {T}

@[simp] lemma flat_pivot {r : fin m} {s : fin n} (hrs : (to_matrix T) r s ≠ 0) :
  flat ((pivot T) r s) = (flat T) :=
by simp only [flat, to_tableau_pivot, to_matrix, to_partition, const];
  exact tableau.flat_pivot hrs

@[simp] lemma res_set_pivot {r : fin m} {s : fin n} (hrs : (to_matrix T) r s ≠ 0) :
  res_set ((pivot T) r s) = (res_set T) :=
by simp only [res_set, flat, to_tableau_pivot, to_matrix, to_partition, const, restricted];
  exact tableau.res_set_pivot hrs

@[simp] lemma dead_set_pivot {r : fin m} {c : fin n} (hrs : (to_matrix T) r c ≠ 0)
  (hdead : c ∉ (dead T)) : dead_set ((pivot T) r c) = (dead_set T) :=
by simp only [dead_set, flat, to_tableau_pivot, to_matrix, to_partition, const, dead] at *;
  exact tableau.dead_set_pivot hrs hdead

@[simp] lemma sol_set_pivot {r : fin m} {c : fin n} (hrs : (to_matrix T) r c ≠ 0)
  (hdead : c ∉ (dead T)) : sol_set ((pivot T) r c) = (sol_set T) :=
by simp [sol_set_eq_dead_set_inter, dead_set_pivot hrs hdead, flat_pivot hrs]

-- lemma mul_single_ext {R : Type*} {m n : ℕ} [semiring R]
--   {A B : matrix (fin m) (fin n) R} (h : ∀ j : fin n, A ⬝ (single j (0 : fin 1)).to_matrix = B ⬝
--     (single j (0 : fin 1)).to_matrix) : A = B :=
-- by ext i j; simpa [matrix_mul_apply] using congr_fun (congr_fun (h j) i) 0

-- lemma single_mul_ext {R : Type*} {m n : ℕ} [semiring R]
--   {A B : matrix (fin m) (fin n) R} (h : ∀ i, (single (0 : fin 1) i).to_matrix ⬝ A =
--     (single (0 : fin 1) i).to_matrix ⬝ B) : A = B :=
-- by ext i j; simpa [mul_matrix_apply] using congr_fun (congr_fun (h i) 0) j

-- lemma ext {T₁ T₂ : X m n} (hflat : T₁.flat = T₂.flat)
--   (hpartition : T₁.to_partition = T₂.to_partition)
--   (hdead : T₁.dead = T₂.dead)
--   (hres : T₁.restricted = T₂.restricted) : T₁ = T₂ :=
-- have hconst : T₁.const = T₂.const,
--   by rw [set.ext_iff] at hflat; simpa [of_col, flat, hpartition, matrix.mul_assoc,
--     mul_right_eq_of_mul_eq (rowp_transpose_mul_rowp _),
--     mul_right_eq_of_mul_eq (colp_transpose_mul_rowp _)] using
--   (hflat (T₁.of_col 0)).1 (of_col_mem_flat _ _),
-- have hmatrix : T₁.to_matrix = T₂.to_matrix,
--   from mul_single_ext $ λ j, begin
--     rw [set.ext_iff] at hflat,
--     have := (hflat (T₁.of_col (single j 0).to_matrix)).1 (of_col_mem_flat _ _),
--     simpa [of_col, hconst, hpartition, flat, matrix.mul_add, matrix.mul_assoc,
--         mul_right_eq_of_mul_eq (rowp_transpose_mul_colp _),
--         mul_right_eq_of_mul_eq (rowp_transpose_mul_rowp _),
--         mul_right_eq_of_mul_eq (colp_transpose_mul_colp _),
--         mul_right_eq_of_mul_eq (colp_transpose_mul_rowp _)] using
--       (hflat (T₁.of_col (single j 0).to_matrix)).1 (of_col_mem_flat _ _)
--   end,
-- by cases T₁; cases T₂; simp * at *

end predicate_lemmas

/-- Conditions for unboundedness based on reading the tableau. The conditions are equivalent to the
  simplex pivot rule failing to find a pivot row. -/
lemma unbounded_of_tableau {T : X m n} {obj : fin m} {c : fin n} (hT : (feasible T))
  (hdead : c ∉ (dead T))
  (hrow : ∀ r, obj ≠ r → (to_partition T).rowg r ∈ (restricted T) →
    0 ≤ (to_matrix T) obj c / (to_matrix T) r c)
  (hc : ((to_matrix T) obj c ≠ 0 ∧ (to_partition T).colg c ∉ (restricted T))
    ∨ (0 < (to_matrix T) obj c ∧ (to_partition T).colg c ∈ (restricted T))) :
  (is_unbounded_above T) ((to_partition T).rowg obj) :=
have hToc : (to_matrix T) obj c ≠ 0, from λ h, by simpa [h, lt_irrefl] using hc,
(lt_or_gt_of_ne hToc).elim
  (λ hToc : (to_matrix T) obj c < 0, is_unbounded_above_rowg_of_nonpos hT c
    (hc.elim and.right (λ h, (not_lt_of_gt hToc h.1).elim)) hdead
    (λ 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 < (to_matrix T) 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))
    hdead hToc)

/-- Conditions for the tableau being feasible, that must be satisified by a simplex pivot rule -/
lemma feasible_pivot {T : X m n} (hT : (feasible T)) {r c}
  (hres : (to_partition T).rowg r ∈ (restricted T))
  (hpos : (to_partition T).colg c ∈ (restricted T) → (to_matrix T) r c < 0)
  (hrmin : ∀ (i : fin m), (to_partition T).rowg i ∈ (restricted T) →
    0 < (to_matrix T) i c / (to_matrix T) r c →
    abs ((const T) r 0 / (to_matrix T) r c) ≤ abs ((const T) i 0 / (to_matrix T) i c)) :
  feasible ((pivot T) r c) :=
by simp only [to_matrix, const, to_partition, restricted, feasible, to_tableau_pivot] at *;
  exact tableau.feasible_pivot hT hres hpos hrmin

lemma feasible_simplex_pivot {T : X m n} {obj : fin m} (hT : (feasible T)) {r c}
  (hres : (to_partition T).rowg r ∈ (restricted T))
  (hrneg : (to_matrix T) obj c / (to_matrix T) r c < 0)
  (hrmin : ∀ (r' : fin m), obj ≠ r' → (to_partition T).rowg r' ∈ (restricted T) →
          (to_matrix T) obj c / (to_matrix T) r' c < 0 →
          abs ((const T) r 0 / (to_matrix T) r c) ≤ abs ((const T) r' 0 / (to_matrix T) r' c))
  (hc : (to_partition T).colg c ∈ (restricted T) → 0 < (to_matrix T) obj c) :
  feasible ((pivot T) r c) :=
feasible_pivot hT hres (λ hcres, inv_neg'.1 (neg_of_mul_neg_left hrneg (le_of_lt (hc hcres))))
  (λ i hires hir,
    have hobji : obj ≠ i,
      from λ hobji, not_lt_of_gt hir (hobji ▸ hrneg),
    (hrmin _ hobji hires $
      have hTrc0 : (to_matrix T) r c ≠ 0, from λ _, by simp [*, lt_irrefl] at *,
      suffices ((to_matrix T) obj c / (to_matrix T) r c) / ((to_matrix T) i c / (to_matrix T) r c) < 0,
        by rwa [div_div_div_cancel_right _ _ hTrc0] at this,
      div_neg_of_neg_of_pos hrneg hir))

-- /-- Used in sign_of_max -/
-- lemma feasible_pivot_obj_of_nonpos {T : X m n} {obj : fin m} (hT : (feasible T)) {c}
--   (hc : (to_partition T).colg c ∈ (restricted T) → 0 < (to_matrix T) obj c)
--   (hr : ∀ r, obj ≠ r → (to_partition T).rowg r ∈ (restricted T) →
--     0 ≤ (to_matrix T) obj c / (to_matrix T) r c)
--   (hobj : (const T) obj 0 ≤ 0) : feasible ((pivot T) obj c) :=
-- λ i hi,
-- if hiobj : i = obj
-- then by rw [hiobj, const_pivot_row, neg_div, neg_nonneg];
--   exact mul_nonpos_of_nonpos_of_nonneg hobj (le_of_lt $ by simp [*, inv_pos'] at *)
-- else begin
--   rw [const_pivot_of_ne _ hiobj],
--   rw [to_partition_pivot, rowg_swap_of_ne _ hiobj, restricted_pivot] at hi,
--   refine add_nonneg (hT _ hi) (neg_nonneg.2 _),
--   rw [div_eq_mul_inv, mul_right_comm],
--   exact mul_nonpos_of_nonneg_of_nonpos
--     (inv_nonneg.1 (by simpa [mul_inv'] using hr _ (ne.symm hiobj) hi))
--     hobj
-- end

-- lemma simplex_const_obj_le {T : X m n} {obj : fin m} (hT : (feasible T)) {r c}
--   (hres : (to_partition T).rowg r ∈ (restricted T))
--   (hrneg : (to_matrix T) obj c / (to_matrix T) r c < 0) :
--   (const T) obj 0 ≤ ((pivot T) r c).const obj 0 :=
-- have obj ≠ r, from λ hor, begin
--   subst hor,
--   by_cases h0 : (to_matrix T) obj c = 0,
--   { simp [lt_irrefl, *] at * },
--   { simp [div_self h0, not_lt_of_le zero_le_one, *] at * }
-- end,
-- by simp only [le_add_iff_nonneg_right, sub_eq_add_neg, neg_nonneg, mul_assoc, div_eq_mul_inv,
--     mul_left_comm ((to_matrix T) obj c), const_pivot_of_ne _ this];
--   exact mul_nonpos_of_nonneg_of_nonpos (hT _ hres) (le_of_lt hrneg)

-- lemma const_eq_zero_of_const_obj_eq {T : X m n} {obj : fin m} (hT : (feasible T)) {r c}
--   (hc : (to_matrix T) obj c ≠ 0) (hrc : (to_matrix T) r c ≠ 0) (hobjr : obj ≠ r)
--   (hobj : ((pivot T) r c).const obj 0 = (const T) obj 0) :
--   (const T) r 0 = 0 :=
-- by rw [const_pivot_of_ne _ hobjr, sub_eq_iff_eq_add, ← sub_eq_iff_eq_add', sub_self,
--     eq_comm, div_eq_mul_inv, mul_eq_zero, mul_eq_zero, inv_eq_zero] at hobj; tauto

end is_tableau


import analysis.normed_space.real_inner_product
import missing_mathlib.linear_algebra.basic

noncomputable theory
open_locale classical

-- TODO: Same for complex inner product?
-- Or for bilinear forms?

variables {V : Type*} [inner_product_space V]

namespace linear_map

def has_adjoint (F G : V →ₗ[ℝ] V) : Prop :=
∀ x y, inner (F x) y = inner x (G y)

lemma has_adjoint_def {F G : V →ₗ[ℝ] V} (hG : has_adjoint F G) :
  ∀ x y, inner (F x) y = inner x (G y) := hG

lemma has_adjoint_symm {F G : V →ₗ[ℝ] V} :
  has_adjoint F G ↔ has_adjoint G F :=
begin
  unfold has_adjoint,
  split,
  repeat
  { intros h x y,
    rw inner_product_space.comm _ y,
    rw inner_product_space.comm x _,
    apply (h y x).symm }
end

lemma has_adjoint_unique_left {F F' G : V →ₗ[ℝ] V}
  (hF : has_adjoint F G) (hF' : has_adjoint F' G) : F = F' :=
begin
  ext,
  rw ←sub_eq_zero,
  apply inner_product_space.definite,
  simp only [inner_sub_left, inner_sub_right],
  simp [has_adjoint_def hF, has_adjoint_def hF']
end

lemma has_adjoint_unique_right {F G G' : V →ₗ[ℝ] V}
  (hG : has_adjoint F G) (hG' : has_adjoint F G') : G = G' :=
begin
  rw has_adjoint_symm at *,
  apply has_adjoint_unique_left hG hG'
end

lemma has_adjoint_zero : has_adjoint (0 : V →ₗ[ℝ] V) 0 :=
by simp [has_adjoint, linear_map.zero_apply, inner_zero_left, inner_zero_right]

lemma has_adjoint_id : has_adjoint (id : V →ₗ[ℝ] V) id :=
by simp [has_adjoint, linear_map.id_apply]

lemma has_adjoint_smul {F G : V →ₗ[ℝ] V} (c : ℝ) :
  has_adjoint F G → has_adjoint (c • F) (c • G) :=
by simp [has_adjoint, inner_smul_left, inner_smul_right] {contextual := tt}

lemma has_adjoint_neg {F G : V →ₗ[ℝ] V} :
  has_adjoint F G → has_adjoint (- F) (- G) :=
begin
  rw ← neg_one_smul _ F,
  rw ← neg_one_smul _ G,
  apply has_adjoint_smul (-1),
end

lemma has_adjoint_add {F G F' G' : V →ₗ[ℝ] V} :
  has_adjoint F G → has_adjoint F' G' → has_adjoint (F + F') (G + G') :=
by simp [has_adjoint, inner_add_left, inner_add_right] {contextual := tt}

lemma has_adjoint_sub {F G F' G' : V →ₗ[ℝ] V} :
  has_adjoint F G → has_adjoint F' G' → has_adjoint (F - F') (G - G') :=
by simp [has_adjoint, inner_add_left, inner_add_right] {contextual := tt}

def adjoint (F : V →ₗ[ℝ] V) : V →ₗ[ℝ] V :=
if h : ∃ G, has_adjoint F G then classical.some h else 0

lemma adjoint_of_has_adjoint {F G : V →ₗ[ℝ] V} (hF : has_adjoint F G) :
  F.adjoint = G :=
begin
  apply has_adjoint_unique_right _ hF,
  rw [adjoint, dif_pos],
  apply classical.some_spec ⟨G, hF⟩,
end

lemma has_adjoint_adjoint {F : V →ₗ[ℝ] V} (h : ∃ G, has_adjoint F G) :
  has_adjoint F (adjoint F) :=
begin
  rcases h with ⟨w, hw⟩,
  rw adjoint_of_has_adjoint hw,
  apply hw,
end

lemma inner_adjoint {F : V →ₗ[ℝ] V} (h : ∃ G, has_adjoint F G) :
  ∀ x y, inner (F x) y = inner x (F.adjoint y) :=
has_adjoint_def (has_adjoint_adjoint h)

lemma adjoint_adjoint {F : V →ₗ[ℝ] V} (h : ∃ G, has_adjoint F G) :
   F.adjoint.adjoint = F :=
begin
  rw adjoint_of_has_adjoint,
  rw has_adjoint_symm,
  apply has_adjoint_adjoint h,
end

lemma adjoint_zero : (0 : V →ₗ[ℝ] V).adjoint = 0 :=
adjoint_of_has_adjoint has_adjoint_zero

lemma adjoint_id : (id : V →ₗ[ℝ] V).adjoint = id :=
adjoint_of_has_adjoint has_adjoint_id

lemma adjoint_smul (c : ℝ) (F : V →ₗ[ℝ] V) (h : ∃ G, has_adjoint F G) :
  (c • F).adjoint = c • F.adjoint :=
adjoint_of_has_adjoint (has_adjoint_smul c (has_adjoint_adjoint h))

lemma adjoint_neg (F : V →ₗ[ℝ] V) (h : ∃ G, has_adjoint F G) :
  (- F).adjoint = - F.adjoint :=
adjoint_of_has_adjoint (has_adjoint_neg (has_adjoint_adjoint h))

lemma adjoint_add (F G : V →ₗ[ℝ] V)
  (hF : ∃ F', has_adjoint F F') (hG : ∃ G', has_adjoint G G'):
  (F + G).adjoint = F.adjoint + G.adjoint :=
adjoint_of_has_adjoint (has_adjoint_add (has_adjoint_adjoint hF) (has_adjoint_adjoint hG))

lemma adjoint_sub (F G : V →ₗ[ℝ] V)
  (hF : ∃ F', has_adjoint F F') (hG : ∃ G', has_adjoint G G'):
  (F - G).adjoint = F.adjoint - G.adjoint :=
adjoint_of_has_adjoint (has_adjoint_sub (has_adjoint_adjoint hF) (has_adjoint_adjoint hG))

def normal (F : V →ₗ[ℝ] V) : Prop :=
∃ G, has_adjoint F G ∧ F.comp G = G.comp F

lemma has_adjoint_of_normal {F : V →ₗ[ℝ] V} (h : normal F) :
  ∃ G, has_adjoint F G :=
begin
  unfold normal at h,
  rcases h with ⟨w, hw⟩,
  use w,
  apply hw.left,
end

lemma adjoint_comm_of_normal {F : V →ₗ[ℝ] V} (h : normal F) :
  F.comp F.adjoint = F.adjoint.comp F :=
begin
  unfold normal at h,
  rcases h with ⟨w, hw⟩,
  rw adjoint_of_has_adjoint hw.left,
  apply hw.right,
end

lemma normal_adjoint_of_normal {F : V →ₗ[ℝ] V} (h : normal F) :
  normal F.adjoint :=
begin
  use F,
  split,
  { rw has_adjoint_symm,
    apply has_adjoint_adjoint (has_adjoint_of_normal h) },
  { rw adjoint_comm_of_normal h },
end

lemma normal_of_has_adjoint_self {F : V →ₗ[ℝ] V} (h : has_adjoint F F) :
  normal F :=
⟨F, ⟨h, rfl⟩⟩

lemma normal_zero : normal (0 : V →ₗ[ℝ] V) :=
normal_of_has_adjoint_self has_adjoint_zero

lemma normal_id : normal (id : V →ₗ[ℝ] V) :=
normal_of_has_adjoint_self has_adjoint_id

lemma normal_smul_of_normal {F : V →ₗ[ℝ] V} (c : ℝ) (h : normal F) :
  normal (c • F) :=
begin
  rcases h with ⟨G, hG_adjoint, hG_comm⟩,
  refine ⟨c • G, ⟨has_adjoint_smul c hG_adjoint, _⟩⟩,
  simp only [comp_smul, smul_comp, hG_comm]
end

lemma normal_neg_of_normal {F : V →ₗ[ℝ] V} (h : normal F) :
  normal (- F) :=
begin
  rw ← neg_one_smul _ F,
  apply normal_smul_of_normal (-1) h,
end

lemma normal_sub_algebra_map_of_normal
  {F G : V →ₗ[ℝ] V} (c : ℝ) (hF : normal F) :
  normal (F - algebra_map _ c) :=
begin
  rcases hF with ⟨G, hG_adjoint, hG_comm⟩,
  refine ⟨G - algebra_map _ c, ⟨has_adjoint_sub hG_adjoint (has_adjoint_smul c has_adjoint_id), _⟩⟩,
  simp only [comp_eq_mul] at *,
  simp [add_mul, mul_add, hG_comm, algebra.commutes]
end

lemma inner_adjoint_eq_inner_of_normal {F : V →ₗ[ℝ] V} (h : normal F) :
  ∀ x, inner (F.adjoint x) (F.adjoint x) = inner (F x) (F x) :=
begin
  intros x,
  rw inner_adjoint (has_adjoint_of_normal h),
  rw ←comp_apply,
  rw ←inner_adjoint (has_adjoint_of_normal h),
  rw ←comp_apply,
  rw adjoint_comm_of_normal h,
  apply inner_comm
end

lemma ker_adjoint_of_normal {F : V →ₗ[ℝ] V} (h : normal F) :
  F.adjoint.ker = F.ker :=
begin
  ext,
  rw [mem_ker, ←inner_self_eq_zero, inner_adjoint_eq_inner_of_normal h,
      mem_ker, ←inner_self_eq_zero],
end

lemma ker_pow_eq_ker_of_normal
  {F : V →ₗ[ℝ] V} (k : ℕ) (hn : normal F) :
  (F ^ k.succ).ker = F.ker :=
begin
  induction k with k ih,
  { refl },
  { ext,
    split,
    { assume h : x ∈ ker (F ^ k.succ.succ),
      have h0 : F.adjoint ((F ^ k.succ) x) = 0,
      { rw [mem_ker, pow_succ, mul_app, ←mem_ker,
          ←ker_adjoint_of_normal hn, mem_ker] at h,
        exact h },
      show x ∈ ker F,
        by rw [←ih, mem_ker, ←inner_self_eq_zero, pow_succ, mul_app,
          inner_adjoint (has_adjoint_of_normal hn), ←mul_app F,
          ←pow_succ, h0, inner_zero_right] },
    { intro h,
      rw [mem_ker] at *,
      rw [pow_succ', mul_app, h, map_zero] } }
end

end linear_map


section relation

inductive rtc {α : Sort*} (r : α → α → Prop) : α → α → Prop
| refl  : ∀ a, rtc a a
| base  : ∀ a b, r a b → rtc a b
| trans : ∀ a b c, rtc a b → rtc b c → rtc a c

section
variables {α : Sort*} {r : α → α → Prop} {a b c : α}
lemma rtc.refl' : rtc r a a := rtc.refl _ _

lemma rtc.base' (h : r a b) : rtc r a b := rtc.base _ _ h

lemma rtc.trans' (h₁ : rtc r a b) (h₂ : rtc r b c) : rtc r a c := rtc.trans _ _ _ h₁ h₂

lemma rtc.base_trans (h₁ : r a b) (h₂ : rtc r b c) : rtc r a c :=
rtc.trans _ _ _ (rtc.base _ _ h₁) h₂

lemma rtc.trans_base (h₁ : rtc r a b) (h₂ : r b c) : rtc r a c :=
rtc.trans _ _ _ h₁ (rtc.base _ _ h₂)
end

end relation