/-
Copyright (c) 2020 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import algebra.category.Module.monoidal
import algebra.category.Algebra.basic
import category_theory.monoidal.Mon_

/-!
# `Mon_ (Module R) ≌ Algebra R`

The category of internal monoid objects in `Module R`
is equivalent to the category of "native" bundled `R`-algebras.

Moreover, this equivalence is compatible with the forgetful functors to `Module R`.
-/

universes v u

open category_theory
open linear_map

open_locale tensor_product

namespace Module

variables {R : Type u} [comm_ring R]

namespace Mon_Module_equivalence_Algebra

@[simps]
instance (A : Mon_ (Module.{u} R)) : ring A.X :=
{ one := A.one (1 : R),
  mul := λ x y, A.mul (x ⊗ₜ y),
  one_mul := λ x, by { convert linear_map.congr_fun A.one_mul ((1 : R) ⊗ₜ x), simp, },
  mul_one := λ x, by { convert linear_map.congr_fun A.mul_one (x ⊗ₜ (1 : R)), simp, },
  mul_assoc := λ x y z, by convert linear_map.congr_fun A.mul_assoc ((x ⊗ₜ y) ⊗ₜ z),
  left_distrib := λ x y z,
  begin
    convert A.mul.map_add (x ⊗ₜ y) (x ⊗ₜ z),
    rw ←tensor_product.tmul_add,
    refl,
  end,
  right_distrib := λ x y z,
  begin
    convert A.mul.map_add (x ⊗ₜ z) (y ⊗ₜ z),
    rw ←tensor_product.add_tmul,
    refl,
  end,
  ..(by apply_instance : add_comm_group A.X) }

instance (A : Mon_ (Module.{u} R)) : algebra R A.X :=
{ map_zero' := A.one.map_zero,
  map_one' := rfl,
  map_mul' := λ x y,
  begin
    have h := linear_map.congr_fun A.one_mul.symm (x ⊗ₜ (A.one y)),
    rwa [monoidal_category.left_unitor_hom_apply, ←A.one.map_smul] at h,
  end,
  commutes' := λ r a,
  begin dsimp,
    have h₁ := linear_map.congr_fun A.one_mul (r ⊗ₜ a),
    have h₂ := linear_map.congr_fun A.mul_one (a ⊗ₜ r),
    exact h₁.trans h₂.symm,
  end,
  smul_def' := λ r a, by { convert (linear_map.congr_fun A.one_mul (r ⊗ₜ a)).symm, simp, },
  ..A.one }

@[simp] lemma algebra_map (A : Mon_ (Module.{u} R)) (r : R) : algebra_map R A.X r = A.one r := rfl

/--
Converting a monoid object in `Module R` to a bundled algebra.
-/
@[simps]
def functor : Mon_ (Module.{u} R) ⥤ Algebra R :=
{ obj := λ A, Algebra.of R A.X,
  map := λ A B f,
  { to_fun := f.hom,
    map_one' := linear_map.congr_fun f.one_hom (1 : R),
    map_mul' := λ x y, linear_map.congr_fun f.mul_hom (x ⊗ₜ y),
    commutes' := λ r, linear_map.congr_fun f.one_hom r,
    ..(f.hom.to_add_monoid_hom) }, }.

/--
Converting a bundled algebra to a monoid object in `Module R`.
-/
@[simps]
def inverse_obj (A : Algebra.{u} R) : Mon_ (Module.{u} R) :=
{ X := Module.of R A,
  one := algebra.linear_map R A,
  mul := @algebra.lmul' R A _ _ _,
  one_mul' :=
  begin
    ext x,
    dsimp,
    rw [algebra.lmul'_apply, monoidal_category.left_unitor_hom_apply, algebra.smul_def],
    refl,
  end,
  mul_one' :=
  begin
    ext x,
    dsimp,
    rw [algebra.lmul'_apply, monoidal_category.right_unitor_hom_apply,
      ←algebra.commutes, algebra.smul_def],
    refl,
  end,
  mul_assoc' :=
  begin
    ext x y z,
    dsimp,
    simp only [mul_assoc, algebra.lmul'_apply],
  end }

/--
Converting a bundled algebra to a monoid object in `Module R`.
-/
@[simps]
def inverse : Algebra.{u} R ⥤ Mon_ (Module.{u} R) :=
{ obj := inverse_obj,
  map := λ A B f,
  { hom := f.to_linear_map, }, }.

end Mon_Module_equivalence_Algebra

open Mon_Module_equivalence_Algebra

/--
The category of internal monoid objects in `Module R`
is equivalent to the category of "native" bundled `R`-algebras.
-/
def Mon_Module_equivalence_Algebra : Mon_ (Module.{u} R) ≌ Algebra R :=
{ functor := functor,
  inverse := inverse,
  unit_iso := nat_iso.of_components
    (λ A,
    { hom := { hom := { to_fun := id, map_add' := λ x y, rfl, map_smul' := λ r a, rfl, },
               mul_hom' := by { ext, dsimp at *,
                                simp only [algebra.lmul'_apply, Mon_.X.ring_mul] } },
      inv := { hom := { to_fun := id, map_add' := λ x y, rfl, map_smul' := λ r a, rfl, },
               mul_hom' := by { ext, dsimp at *,
                                simp only [algebra.lmul'_apply, Mon_.X.ring_mul]} } })
    (by tidy),
  counit_iso := nat_iso.of_components (λ A,
  { hom :=
    { to_fun := id,
      map_zero' := rfl,
      map_add' := λ x y, rfl,
      map_one' := (algebra_map R A).map_one,
      map_mul' := λ x y, algebra.lmul'_apply,
      commutes' := λ r, rfl, },
    inv :=
    { to_fun := id,
      map_zero' := rfl,
      map_add' := λ x y, rfl,
      map_one' := (algebra_map R A).map_one.symm,
      map_mul' := λ x y, algebra.lmul'_apply.symm,
      commutes' := λ r, rfl } }) (by { intros, refl }), }.

/--
The equivalence `Mon_ (Module R) ≌ Algebra R`
is naturally compatible with the forgetful functors to `Module R`.
-/
def Mon_Module_equivalence_Algebra_forget :
  Mon_Module_equivalence_Algebra.functor ⋙ forget₂ (Algebra.{u} R) (Module.{u} R) ≅
    Mon_.forget (Module.{u} R):=
nat_iso.of_components (λ A,
{ hom :=
  { to_fun := id,
    map_add' := λ x y, rfl,
    map_smul' := λ c x, rfl },
  inv :=
  { to_fun := id,
    map_add' := λ x y, rfl,
    map_smul' := λ c x, rfl }, }) (by tidy)

end Module


import data.matrix data.rat.basic
import linear_algebra.determinant .misc order.pilex
import order.lexicographic .list_sup .fin_find tactic.omega tactic.abel
import data.list.min_max algebra.associated .matrix_pequiv

open matrix fintype finset function

variables {m n : ℕ}
variables (A : matrix (fin m) (fin n) ℚ)

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

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

-- def row (i : fin m) : rvec n := λ _ j, A i j

variables (b : cvec m) (c : cvec n)

def cvec.ordered_comm_group : ordered_comm_group (cvec n) :=
matrix.ordered_comm_group

local attribute [instance] cvec.ordered_comm_group

def cvec.decidable_le : decidable_rel ((≤) : (cvec n) → (cvec n) → Prop) :=
matrix.decidable_le

local attribute [instance] cvec.decidable_le

--instance : partial_order (matrix (fin m) (fin n) ℚ) := pi.partial_order

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

def is_feasible (x : cvec n) : Prop :=
0 ≤ x ∧ A ⬝ x = b

instance (x : cvec n) : decidable (is_feasible A b x) :=
by dunfold is_feasible; apply_instance

def is_optimal (x : cvec n) : Prop :=
is_feasible A b x ∧ ∀ y, is_feasible A b y → cᵀ ⬝ y ≤ cᵀ ⬝ x

def is_invertible' (M : matrix (fin m) (fin n) ℚ) : Prop :=
∃ h : m = n, by rw h at M; exact det M ≠ 0

instance is_invertible'.decidable : decidable_pred (@is_invertible' m n) :=
λ _, by unfold is_invertible'; apply_instance

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

def lex_rvec : linear_order (rvec m) :=
@pilex.linear_order _ _ _ (is_well_order.wf _)
  (λ _, pilex.linear_order (is_well_order.wf _))

def lex_rvec_decidable_linear_order : decidable_linear_order (rvec m) :=
{ decidable_le := λ x y, decidable_of_iff
    (list.lex (<) (rvec.to_list x) (rvec.to_list y) ∨ x = y) sorry,
  ..lex_rvec }

local attribute [instance] lex_rvec_decidable_linear_order

def lex_ordered_comm_group_rvec : ordered_comm_group (rvec m) :=
@pilex.ordered_comm_group _ _ _ (λ _, pilex.ordered_comm_group)

-- local attribute [instance] lex_ordered_comm_group_rvec
--   lex_rvec_decidable_linear_order

def pert_rat (m : ℕ) : Type := ℚ × rvec m

instance : decidable_eq (pert_rat m) := by unfold pert_rat; apply_instance

instance : add_comm_group (pert_rat m) := prod.add_comm_group

instance : module ℚ (pert_rat m) := prod.module

instance : decidable_linear_order (pert_rat m) :=
by letI := @lex_rvec_decidable_linear_order m; exact
{ decidable_le := @prod.lex.decidable _ _ _ _ _ _ _
    (lex_rvec_decidable_linear_order).decidable_le,
  ..lex_linear_order }

instance pert_rat.decidable_le (i j : pert_rat m) : decidable (i ≤ j) :=
@decidable_linear_order.decidable_le _ pert_rat.decidable_linear_order i j

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

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

instance : has_repr (pert_rat m) := prod.has_repr

open list

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

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

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

structure prebasis (m n : ℕ) : Type :=
( basis : pequiv (fin m) (fin n) )
( nonbasis : pequiv (fin (n - m)) (fin n) )
( basis_left_inv : basis.trans basis.symm = pequiv.refl (fin m) )
( nonbasis_left_inv : nonbasis.trans nonbasis.symm = pequiv.refl (fin (n - m)) )
( basis_trans_nonbasis_symm_eq_bot : basis.trans nonbasis.symm = ⊥ )

namespace prebasis
open pequiv

attribute [simp] basis_left_inv nonbasis_left_inv basis_trans_nonbasis_symm_eq_bot

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

lemma mul_symm_add_mul_symm (B : prebasis m n) :
  ((B.basis.symm.trans B.basis).to_matrix : matrix (fin n) (fin n) ℚ) +
  (B.nonbasis.symm.trans B.nonbasis).to_matrix = 1 :=
begin
  ext,
  simp only [add_val, pequiv.symm_trans, pequiv.to_matrix, one_val,
    pequiv.mem_of_set_iff, set.mem_set_of_eq],
  have := is_some_basis_iff B j,
  split_ifs; tauto
end

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

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

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

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

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

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

lemma mul_single_ext {A B : matrix (fin m) (fin n) ℚ}
  (h : ∀ j, 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

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

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

lemma swap_mul_swap_inverse' {A : matrix (fin m) (fin n) ℚ} {B : prebasis m n}
  {r : fin m} {s : fin (n - m)} (hAB : (A ⬝ B.basis.to_matrixᵀ).has_left_inverse)
  (h : pivot_element (inverse (A ⬝ B.basis.to_matrixᵀ) ⬝ A) B r s ≠ 0) :
  swap_inverse (inverse (A ⬝ B.basis.to_matrixᵀ) ⬝ A) B r s ⬝ inverse (A ⬝ B.basis.to_matrixᵀ) ⬝
  (A ⬝ (B.swap r s).basis.to_matrixᵀ) = 1 :=
have inverse (A ⬝ (to_matrix (B.basis))ᵀ) ⬝ A ⬝ (to_matrix (B.basis))ᵀ = 1,
  by rw [matrix.mul_assoc]; exact matrix.inverse_mul hAB,
by rw [← swap_mul_swap_inverse (inverse (A ⬝ B.basis.to_matrixᵀ) ⬝ A) B this r s h];
    simp [matrix.mul_assoc]

lemma has_left_inverse_swap {A : matrix (fin m) (fin n) ℚ} {B : prebasis m n}
  {r : fin m} {s : fin (n - m)} (hAB : (A ⬝ B.basis.to_matrixᵀ).has_left_inverse)
  (h : pivot_element (inverse (A ⬝ B.basis.to_matrixᵀ) ⬝ A) B r s ≠ 0) :
  (A ⬝ (B.swap r s).basis.to_matrixᵀ).has_left_inverse :=
⟨_, swap_mul_swap_inverse' hAB h⟩

lemma inverse_swap_eq {A : matrix (fin m) (fin n) ℚ} {B : prebasis m n}
  {r : fin m} {s : fin (n - m)} (hAB : (A ⬝ B.basis.to_matrixᵀ).has_left_inverse)
  (h : pivot_element (inverse (A ⬝ B.basis.to_matrixᵀ) ⬝ A) B r s ≠ 0) :
  inverse (A ⬝ (B.swap r s).basis.to_matrixᵀ) = swap_inverse
    (inverse (A ⬝ B.basis.to_matrixᵀ) ⬝ A) B r s ⬝ inverse (A ⬝ B.basis.to_matrixᵀ) :=
by conv_lhs {rw [← matrix.one_mul (inverse (A ⬝ (B.swap r s).basis.to_matrixᵀ)),
    ← swap_mul_swap_inverse' hAB h, matrix.mul_assoc,
    matrix.mul_inverse (has_right_inverse_iff_has_left_inverse.1 (has_left_inverse_swap hAB h)),
    matrix.mul_one]}

local prefix `?` := pequiv.to_matrix

lemma cvec_eq_basis_add_nonbasis (x : cvec n) (B : prebasis m n) :
  x = B.basis.to_matrixᵀ ⬝ B.basis.to_matrix ⬝ x + B.nonbasis.to_matrixᵀ ⬝ B.nonbasis.to_matrix ⬝ x :=
by conv_lhs {rw [← x.one_mul, ← mul_symm_add_mul_symm B] };
  simp [to_matrix_symm, to_matrix_trans, matrix.mul_add, matrix.add_mul, matrix.mul_assoc]

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

lemma objective_function_eq
  (A : matrix (fin m) (fin n) ℚ) (c : rvec n) (b : cvec m) (x : cvec n) (B : prebasis m n)
  (h : A ⬝ x = b) (hAB : (A ⬝ B.basis.to_matrixᵀ).has_left_inverse) :
  c ⬝ x = c ⬝ B.basis.to_matrixᵀ ⬝ inverse (A ⬝ B.basis.to_matrixᵀ) ⬝ b +
  reduced_cost A c B ⬝ B.nonbasis.to_matrix ⬝ x :=
have B.basis.to_matrix ⬝ x = inverse (A ⬝ B.basis.to_matrixᵀ) ⬝ b -
  inverse (A ⬝ B.basis.to_matrixᵀ) ⬝ A ⬝ B.nonbasis.to_matrixᵀ
  ⬝ B.nonbasis.to_matrix ⬝ x,
  begin
    have := congr_arg ((⬝) (inverse (A ⬝ B.basis.to_matrixᵀ))) h,
    rw [cvec_eq_basis_add_nonbasis x B, matrix.mul_add,
      matrix.mul_add, ← A.mul_assoc, ← A.mul_assoc, ← A.mul_assoc,
      ← A.mul_assoc, ← (inverse (A ⬝ B.basis.to_matrixᵀ)).mul_assoc,
      ← (inverse (A ⬝ B.basis.to_matrixᵀ)).mul_assoc, inverse_mul hAB,
      matrix.one_mul, ← eq_sub_iff_add_eq] at this,
    simp [this, matrix.mul_assoc]
  end,
begin
  conv_lhs {rw [cvec_eq_basis_add_nonbasis x B, matrix.mul_assoc, this]},
  simp [matrix.mul_add, matrix.mul_assoc, matrix.add_mul, reduced_cost, matrix.one_mul],
end

def objective_function_of_prebasis (A : matrix (fin m) (fin n) ℚ)
  (c : rvec n) (b : cvec m) (B : prebasis m n) : matrix (fin 1) (fin 1) ℚ :=
c ⬝ (B.basis.to_matrixᵀ ⬝ inverse (A ⬝ B.basis.to_matrixᵀ) ⬝ b)

local notation `.` := pequiv.to_matrix

local postfix `⁻¹` := inverse

@[simp] lemma single_mul_single {k : ℕ} (a : fin m) (b : fin n) (c : fin k) :
  ((single a b).to_matrix : matrix _ _ ℚ) ⬝ (single b c).to_matrix = (single a c).to_matrix :=
by rw [← to_matrix_trans, single_trans_single]

@[simp] lemma single_mul_single_right {k l : ℕ} (a : fin m) (b : fin n) (c : fin k)
  (M : matrix (fin k) (fin l) ℚ) :
  (single a b).to_matrix ⬝ ((single b c).to_matrix ⬝ M) = (single a c).to_matrix ⬝ M :=
by rw [← matrix.mul_assoc, single_mul_single]

example (A : matrix (fin m) (fin n) ℚ) (B : prebasis m n) (r : fin m) (s : fin (n - m)) :
  (single (0 : fin 1) r).to_matrix ⬝ inverse (A ⬝ (B.swap r s).basis.to_matrixᵀ) =
  inverse (pivot_element (inverse (A ⬝ (?(B.basis))ᵀ) ⬝ A) B r s) ⬝ (single 0 r).to_matrix :=
begin
  rw [pivot_element, swap_basis_eq], dsimp,
  squeeze_simp [matrix.mul_add, matrix.add_mul, matrix.one_mul, matrix.mul_one,
    sub_eq_add_neg, matrix.mul_neg, matrix.neg_mul, pivot_element, matrix.mul_assoc],

end

lemma objective_function_swap_eq {A : matrix (fin m) (fin n) ℚ}
  (c : rvec n) (b : cvec m) {B : prebasis m n} {r : fin m} {s : fin (n - m)}
  (hAB : (A ⬝ B.basis.to_matrixᵀ).has_left_inverse)
  (hpivot : pivot_element ((A ⬝ (?(B.basis))ᵀ)⁻¹ ⬝ A) B r s ≠ 0) :
  objective_function_of_prebasis A c b (B.swap r s) =
  objective_function_of_prebasis A c b B + reduced_cost A c B ⬝ (single s 0).to_matrix ⬝
    ratio (inverse (A ⬝ B.basis.to_matrixᵀ) ⬝ A) b B r s :=
calc objective_function_of_prebasis A c b (B.swap r s)
    = c ⬝ (B.swap r s).basis.to_matrixᵀ ⬝ inverse (A ⬝ (B.swap r s).basis.to_matrixᵀ) ⬝ b +
      (reduced_cost A c _) ⬝
      (B.swap r s).nonbasis.to_matrix ⬝ ((B.swap r s).basis.to_matrixᵀ ⬝ -- this line is zero
      inverse (A ⬝ (B.swap r s).basis.to_matrixᵀ) ⬝ b) :
  begin
    rw [objective_function_of_prebasis],
    refine objective_function_eq A c b _ (B.swap r s) _ (has_left_inverse_swap hAB hpivot),
    rw [← A.mul_assoc, ← A.mul_assoc, matrix.mul_inverse (has_right_inverse_iff_has_left_inverse.1
      (has_left_inverse_swap hAB hpivot)), matrix.one_mul]
  end
... = c ⬝ (B.swap r s).basis.to_matrixᵀ ⬝ inverse (A ⬝ (B.swap r s).basis.to_matrixᵀ) ⬝ b :
  have ((B.swap r s).nonbasis.to_matrix ⬝ (B.swap r s).basis.to_matrixᵀ : matrix _ _ ℚ) = 0,
    by rw [← to_matrix_symm, ← to_matrix_trans, nonbasis_trans_basis_symm_eq_bot, to_matrix_bot],
  by simp [matrix.mul_assoc, mul_right_eq_of_mul_eq this, matrix.zero_mul, matrix.mul_zero]
... = _ : begin
  have : (B.nonbasis.to_matrix : matrix _ _ ℚ) ⬝ (swap B r s).basis.to_matrixᵀ = (single s r).to_matrix,
  { rw [← to_matrix_symm, ← to_matrix_trans, nonbasis_mul_swap_basis_tranpose] },
  rw [c.mul_assoc, c.mul_assoc, objective_function_eq A c b _ B _ _],
  rw [objective_function_of_prebasis, c.mul_assoc, c.mul_assoc, add_left_cancel_iff],
  simp only [matrix.mul_assoc, mul_right_eq_of_mul_eq this, ratio],
  refine congr_arg ((⬝) (reduced_cost _ _ _)) _,
  rw [inverse_swap_eq hAB hpivot, swap_inverse],
  simp [sub_eq_add_neg, matrix.mul_assoc, matrix.mul_add, matrix.add_mul,
    matrix.mul_neg, matrix.neg_mul, matrix.one_mul, matrix.mul_one],

end

-- end prebasis

-- def pivot (A : matrix (fin m) (fin n) ℚ) (c : rvec n) (b : cvec m)
--   (B : array m (fin n))
--   (NB : array (n - m) (fin n))
--   (i : fin (n - m)) (j : fin m) :
--   array m (fin n) × -- basis
--   array (n - m) (fin n) × -- non basis
--   matrix (fin m) (fin (n - m)) ℚ × -- A_bar
--   (rvec m) × -- c_B
--   (rvec (n - m)) × --c_N
--   (cvec m) × --b_bar
--   matrix (fin m) (fin m) ℚ -- pert
--   :=
-- let NBi : fin n := NB.read i in
-- let Bj : fin n := B.read j in
-- let NB' := NB.write i Bj in
-- let B' := B.write j NBi in
-- let A_B'_inverse := _root_.inverse (minor A id B'.read) in
-- ⟨B',
--   NB',
--   A_B'_inverse ⬝ minor A id NB'.read,
--   minor c id B'.read,
--   minor c id NB'.read,
--   A_B'_inverse ⬝ b,
--   A_B'_inverse⟩

-- /-- given a basis, such that A_B is invertible, `solution_of_basis` returns `x` such that `A ⬝ x = b`. -/
-- def solution_of_basis (A : matrix (fin m) (fin n) ℚ) (b : cvec m) (B : prebasis m n) : cvec n :=
-- minor 1 id B.1.nth ⬝ inverse (minor A id B.1.nth) ⬝ b

local notation `£` := default _

@[simp] lemma univ_unique {α : Type*} [unique α] {h : fintype α} : @univ α h = {default α} :=
finset.ext.2 $ λ x, by simpa using unique.eq_default x

lemma solution_of_basis_is_solution (A : matrix (fin m) (fin n) ℚ) (b : cvec m)
  (B : prebasis m n) (hB : has_right_inverse (minor A id B.1.nth)) :
  A ⬝ solution_of_basis A b B = b :=
by rw [solution_of_basis, ← A.mul_assoc, ← A.mul_assoc,  ← minor_eq_minor_one_mul A,
    mul_inverse hB, b.one_mul];
  apply_instance

/-- function used solely for proof of termination. Never executed -/
def lex_objective_function (A : matrix (fin m) (fin n) ℚ)
  (c : rvec n) (b : cvec m) (B : prebasis m n) : ℚ × rvec m :=
((one_by_one_ring_equiv (fin 1) ℚ).to_equiv (minor c id B.1.nth ⬝ inverse (minor A id B.1.nth) ⬝ b),
  minor c id B.1.nth ⬝ inverse (minor A id B.1.nth))

lemma lex_objective_function_increasing (A : matrix (fin m) (fin n) ℚ)
  (c : rvec n) (b : cvec m) (B : prebasis m n) (i : fin (n - m)) (j : fin m) :
  lex_objective_function A c b B < lex_objective_function A c b (B.swap i j) :=
begin
  dsimp [lex_objective_function],

end

def simplex [inhabited (fin m)] (A : matrix (fin m) (fin n) ℚ)
  (c : rvec n) (b : cvec m) :
  Π (B : array m (fin n))
  (NB : array (n - m) (fin n))
  (A_bar : matrix (fin m) (fin (n - m)) ℚ)
  (c_B : rvec m) (c_N : rvec (n - m)) (b_bar : cvec m)
  (pert : (matrix (fin m) (fin m) ℚ))
  (pivots : ℕ),
  ℕ × option
  (array m (fin n) × -- basis
  array (n - m) (fin n) × -- non basis
  matrix (fin m) (fin (n - m)) ℚ × -- A_bar
  (rvec m) × -- c_B
  (rvec (n - m)) × --c_N
  (cvec m) × --b_bar
  matrix (fin m) (fin m) ℚ) -- pert)
| B NB A_bar c_B c_N b_bar pert pivots :=
let reduced_cost := c_N - c_B ⬝ A_bar in
let i' := (list.fin_range (n - m)).find (λ i, 0 < column reduced_cost (fin 1) i) in
match i' with
| none := (pivots, some (B, NB, A_bar, c_B, c_N, b_bar, pert))
| some i :=
  let ratio_pert : fin m → pert_rat m := λ j : fin m,
    (A_bar j i)⁻¹ • (b_bar j 0, row' pert (fin 1) j) in
  let l := (list.fin_range m).filter (λ j, 0 < ratio_pert j) in
  match l with
  | [] := (pivots + 1, none)
  | (a::l) :=
  let j : fin m := list.argmin ratio_pert (a :: l) in
  let ⟨B', NB', A_bar', c_B', c_N', b_bar', pert'⟩ :=
    pivot A c b B NB i j in
  have wf : true, from trivial,
  simplex B' NB' A_bar' c_B' c_N' b_bar' pert' (pivots + 1)
  end
end
using_well_founded {rel_tac := λ _ _, `[exact ⟨_, true_well_founded⟩],
  dec_tac := tactic.assumption}

instance read_dec_pred (a : array m (fin n)) (i : fin n) :
  decidable_pred (λ (k : fin m), array.read a k = i) := by apply_instance

def find_optimal_solution_from_starting_basis [inhabited (fin m)] (A : matrix (fin m) (fin n) ℚ)
  (c : rvec n) (b : cvec m) (B : array m (fin n)) : ℕ × option (cvec n) :=
let NB : array (n - m) (fin n) :=
  vector.to_array ⟨(list.fin_range n).filter (λ i, ¬ B.mem i), sorry⟩ in
let A_B := minor A id B.read in
let A_N := minor A id NB.read in
let pert := _root_.inverse A_B in
let A_bar := pert ⬝ A_N in
let c_B := minor c id B.read in
let c_N := minor c id NB.read in
let b_bar := pert ⬝ b in
match simplex A c b B NB A_bar c_B c_N b_bar pert 0 with
| (pivots, none) := (pivots, none)
| (pivots, some ⟨B', NB', A_bar', c_B', c_N', b_bar', pert'⟩) := prod.mk pivots $
some (λ i _,
  match @fin.find _ (λ k, B'.read k = i) (read_dec_pred _ _) with
  | none := 0
  | some k := b_bar' k 0
  end)
end

/- test code -/

instance {m : ℕ} : inhabited (fin m.succ) := ⟨0⟩

def found_solution_is_feasible [inhabited (fin m)] (A : matrix (fin m) (fin n) ℚ)
  (c : rvec n) (b : cvec m) (B : array m (fin n)) : bool :=
match find_optimal_solution_from_starting_basis A c b B with
| (_, none) := tt
| (_, some x) := (A ⬝ x = b ∧ 0 ≤ x : bool)
end

def is_optimal_bool [inhabited (fin m)] (A : matrix (fin m) (fin n) ℚ)
  (c : rvec n) (b : cvec m) (B : array m (fin n)) : bool :=
let NB : array (n - m) (fin n) :=
  vector.to_array ⟨(list.fin_range n).filter (λ i, ¬ B.mem i), sorry⟩ in
let A_B := minor A id B.read in
let A_N := minor A id NB.read in
let pert := _root_.inverse A_B in
let A_bar := pert ⬝ A_N in
let c_B := minor c id B.read in
let c_N := minor c id NB.read in
let b_bar := pert ⬝ b in
match simplex A c b B NB A_N c_B c_N b_bar pert 0 with
| (_, none) := tt
| (_, some ⟨B', NB', A_bar', c_B', c_N', b_bar', pert'⟩) := c_N' - c_B' ⬝ A_bar' ≤ 0
end

def is_feasible_basis [inhabited (fin m)] (A : matrix (fin m) (fin n) ℚ)
  (c : rvec n) (b : cvec m) (B : array m (fin n)) : Prop :=
let A_B := minor A id B.read in
let NB : array (n - m) (fin n) :=
  vector.to_array ⟨(list.fin_range n).filter (λ i, ¬ B.mem i), sorry⟩ in
let A_N := minor A id NB.read in
let pert := _root_.inverse A_B in
let A_bar := pert ⬝ A_N in
let c_B := minor c id B.read in
let c_N := minor c id NB.read in
let b_bar := pert ⬝ b in
let x : cvec n := λ i _, match @fin.find _ (λ k, B.read k = i) (read_dec_pred _ _) with
  | none := 0
  | some k := b_bar k 0
  end in
(0 : cvec n) ≤ x ∧ A ⬝ x = b ∧ det A_B ≠ 0

def finishing_basis [inhabited (fin m)] (A : matrix (fin m) (fin n) ℚ)
  (c : rvec n) (b : cvec m) (B : array m (fin n)) : option (array m (fin n)) :=
let NB : array (n - m) (fin n) :=
  vector.to_array ⟨(list.fin_range n).filter (λ i, ¬ B.mem i), sorry⟩ in
let A_B := minor A id B.read in
let A_N := minor A id NB.read in
let pert := _root_.inverse A_B in
let A_bar := pert ⬝ A_N in
let c_B := minor c id B.read in
let c_N := minor c id NB.read in
let b_bar := pert ⬝ b in
option.map prod.fst (simplex A c b B NB A_N c_B c_N b_bar pert 0).2

def test  [inhabited (fin m)] (A : matrix (fin m) (fin n) ℚ)
  (c : rvec n) (b : cvec m) (B : array m (fin n)) :=
let NB : array (n - m) (fin n) :=
  vector.to_array ⟨(list.fin_range n).filter (λ i, ¬ B.mem i), sorry⟩ in
let A_B := minor A id B.read in
let A_N := minor A id NB.read in
let pert := _root_.inverse A_B in
let A_bar := pert ⬝ A_N in
let c_B := minor c id B.read in
let c_N := minor c id NB.read in
let b_bar := pert ⬝ b in
let reduced_cost := c_N - c_B ⬝ A_bar in
let b_pert : fin m → pert_rat m := λ j : fin m,
     (A_bar j ⟨0, sorry⟩)⁻¹ • (b_bar j 0, row' pert (fin 1) j) in
let reduced_cost := c_N - c_B ⬝ A_bar in
let i' := (list.fin_range (n - m)).find (λ i, 0 < column reduced_cost (fin 1) i) in
match i' with
| none := sorry
| some i :=
  let ratio_pert : fin m → pert_rat m := λ j : fin m,
     (A_bar j i)⁻¹ • (b_bar j 0, row' pert (fin 1) j) in
  let l := (list.fin_range m).filter (λ j, 0 < ratio_pert j) in ratio_pert end
--simplex A c b B NB A_N c_B c_N b_bar pert

def objective_function_value (c : rvec n) (x : cvec n) := c ⬝ x

-- (list.fin_range (n - m)).find (λ i, 0 < column reduced_cost (fin 1) i)

-- pivot A c b B NB

instance [inhabited (fin m)] (A : matrix (fin m) (fin n) ℚ)
  (c : rvec n) (b : cvec m) (B : array m (fin n)) :
  decidable (is_feasible_basis A c b B) :=
by dunfold is_feasible_basis; apply_instance

-- def ex.A := list.to_matrix 3 4 [[12,-1,1,1],
--                      [1,1.45,1,0],
--                      [1,2,0,1]]

-- def ex.c : rvec 4 := λ _ i, (list.nth_le [1, 1.2, 1, 1.3] i sorry)
-- --#eval ex.c
-- def ex.b : cvec 3 := (λ i _, (list.nth_le [2, 2, 4] i sorry))
-- --#eval ex.b
-- def ex.B : array 3 (fin 4) := list.to_array [0, 1, 3]

-- def ex.NB : array 1 (fin 4) := list.to_array [2]

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

-- def ex.b : cvec 2 := (λ i _, (list.nth_le [8,0] i sorry))
-- --#eval ex.b
-- def ex.c : rvec 5 := λ _ i, (list.nth_le [1, 1, 1, 0, 0] i sorry)
-- --#eval ex.c
-- def ex.B : array 2 (fin 5) := list.to_array [3,4]

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

def ex.b : cvec 3 := (λ i _, list.nth_le [0,0,1] i sorry)
--#eval ex.b
def ex.c : rvec 7 := λ _ i, (list.nth_le [3/4, -20, 1/2, -6, 0, 0, 0] i sorry)
--#eval ex.c
def ex.B : array 3 (fin 7) := list.to_array [4,5,6]

-- #eval (found_solution_is_feasible ex.A ex.c ex.b ex.B)

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

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

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

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

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


/-
Copyright (c) 2020 Sébastien Gouëzel. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Sébastien Gouëzel

! This file was ported from Lean 3 source module topology.algebra.module.multilinear
! leanprover-community/mathlib commit ce11c3c2a285bbe6937e26d9792fda4e51f3fe1a
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Topology.Algebra.Module.Basic
import Mathbin.LinearAlgebra.Multilinear.Basic

/-!
# Continuous multilinear maps

We define continuous multilinear maps as maps from `Π(i : ι), M₁ i` to `M₂` which are multilinear
and continuous, by extending the space of multilinear maps with a continuity assumption.
Here, `M₁ i` and `M₂` are modules over a ring `R`, and `ι` is an arbitrary type, and all these
spaces are also topological spaces.

## Main definitions

* `continuous_multilinear_map R M₁ M₂` is the space of continuous multilinear maps from
  `Π(i : ι), M₁ i` to `M₂`. We show that it is an `R`-module.

## Implementation notes

We mostly follow the API of multilinear maps.

## Notation

We introduce the notation `M [×n]→L[R] M'` for the space of continuous `n`-multilinear maps from
`M^n` to `M'`. This is a particular case of the general notion (where we allow varying dependent
types as the arguments of our continuous multilinear maps), but arguably the most important one,
especially when defining iterated derivatives.
-/

open Function Fin Set

open BigOperators

universe u v w w₁ w₁' w₂ w₃ w₄

variable {R : Type u} {ι : Type v} {n : ℕ} {M : Fin n.succ → Type w} {M₁ : ι → Type w₁}
  {M₁' : ι → Type w₁'} {M₂ : Type w₂} {M₃ : Type w₃} {M₄ : Type w₄}

/-- Continuous multilinear maps over the ring `R`, from `Πi, M₁ i` to `M₂` where `M₁ i` and `M₂`
are modules over `R` with a topological structure. In applications, there will be compatibility
conditions between the algebraic and the topological structures, but this is not needed for the
definition. -/
structure ContinuousMultilinearMap (R : Type u) {ι : Type v} (M₁ : ι → Type w₁) (M₂ : Type w₂)
  [Semiring R] [∀ i, AddCommMonoid (M₁ i)] [AddCommMonoid M₂] [∀ i, Module R (M₁ i)] [Module R M₂]
  [∀ i, TopologicalSpace (M₁ i)] [TopologicalSpace M₂] extends MultilinearMap R M₁ M₂ where
  cont : Continuous to_fun
#align continuous_multilinear_map ContinuousMultilinearMap

-- mathport name: «expr [× ]→L[ ] »
notation:25 M "[×" n "]→L[" R "] " M' => ContinuousMultilinearMap R (fun i : Fin n => M) M'

namespace ContinuousMultilinearMap

section Semiring

variable [Semiring R] [∀ i, AddCommMonoid (M i)] [∀ i, AddCommMonoid (M₁ i)]
  [∀ i, AddCommMonoid (M₁' i)] [AddCommMonoid M₂] [AddCommMonoid M₃] [AddCommMonoid M₄]
  [∀ i, Module R (M i)] [∀ i, Module R (M₁ i)] [∀ i, Module R (M₁' i)] [Module R M₂] [Module R M₃]
  [Module R M₄] [∀ i, TopologicalSpace (M i)] [∀ i, TopologicalSpace (M₁ i)]
  [∀ i, TopologicalSpace (M₁' i)] [TopologicalSpace M₂] [TopologicalSpace M₃] [TopologicalSpace M₄]
  (f f' : ContinuousMultilinearMap R M₁ M₂)

instance : CoeFun (ContinuousMultilinearMap R M₁ M₂) fun _ => (∀ i, M₁ i) → M₂ :=
  ⟨fun f => f.toFun⟩

/-- See Note [custom simps projection]. We need to specify this projection explicitly in this case,
  because it is a composition of multiple projections. -/
def Simps.apply (L₁ : ContinuousMultilinearMap R M₁ M₂) (v : ∀ i, M₁ i) : M₂ :=
  L₁ v
#align continuous_multilinear_map.simps.apply ContinuousMultilinearMap.Simps.apply

initialize_simps_projections ContinuousMultilinearMap (-toMultilinearMap,
  to_multilinear_map_to_fun → apply)

@[continuity]
theorem coe_continuous : Continuous (f : (∀ i, M₁ i) → M₂) :=
  f.cont
#align continuous_multilinear_map.coe_continuous ContinuousMultilinearMap.coe_continuous

@[simp]
theorem coe_coe : (f.toMultilinearMap : (∀ i, M₁ i) → M₂) = f :=
  rfl
#align continuous_multilinear_map.coe_coe ContinuousMultilinearMap.coe_coe

theorem toMultilinearMap_inj :
    Function.Injective
      (ContinuousMultilinearMap.toMultilinearMap :
        ContinuousMultilinearMap R M₁ M₂ → MultilinearMap R M₁ M₂)
  | ⟨f, hf⟩, ⟨g, hg⟩, rfl => rfl
#align continuous_multilinear_map.to_multilinear_map_inj ContinuousMultilinearMap.toMultilinearMap_inj

@[ext]
theorem ext {f f' : ContinuousMultilinearMap R M₁ M₂} (H : ∀ x, f x = f' x) : f = f' :=
  toMultilinearMap_inj <| MultilinearMap.ext H
#align continuous_multilinear_map.ext ContinuousMultilinearMap.ext

theorem ext_iff {f f' : ContinuousMultilinearMap R M₁ M₂} : f = f' ↔ ∀ x, f x = f' x := by
  rw [← to_multilinear_map_inj.eq_iff, MultilinearMap.ext_iff] <;> rfl
#align continuous_multilinear_map.ext_iff ContinuousMultilinearMap.ext_iff

@[simp]
theorem map_add [DecidableEq ι] (m : ∀ i, M₁ i) (i : ι) (x y : M₁ i) :
    f (update m i (x + y)) = f (update m i x) + f (update m i y) :=
  f.map_add' m i x y
#align continuous_multilinear_map.map_add ContinuousMultilinearMap.map_add

@[simp]
theorem map_smul [DecidableEq ι] (m : ∀ i, M₁ i) (i : ι) (c : R) (x : M₁ i) :
    f (update m i (c • x)) = c • f (update m i x) :=
  f.map_smul' m i c x
#align continuous_multilinear_map.map_smul ContinuousMultilinearMap.map_smul

theorem map_coord_zero {m : ∀ i, M₁ i} (i : ι) (h : m i = 0) : f m = 0 :=
  f.toMultilinearMap.map_coord_zero i h
#align continuous_multilinear_map.map_coord_zero ContinuousMultilinearMap.map_coord_zero

@[simp]
theorem map_zero [Nonempty ι] : f 0 = 0 :=
  f.toMultilinearMap.map_zero
#align continuous_multilinear_map.map_zero ContinuousMultilinearMap.map_zero

instance : Zero (ContinuousMultilinearMap R M₁ M₂) :=
  ⟨{ (0 : MultilinearMap R M₁ M₂) with cont := continuous_const }⟩

instance : Inhabited (ContinuousMultilinearMap R M₁ M₂) :=
  ⟨0⟩

@[simp]
theorem zero_apply (m : ∀ i, M₁ i) : (0 : ContinuousMultilinearMap R M₁ M₂) m = 0 :=
  rfl
#align continuous_multilinear_map.zero_apply ContinuousMultilinearMap.zero_apply

@[simp]
theorem toMultilinearMap_zero : (0 : ContinuousMultilinearMap R M₁ M₂).toMultilinearMap = 0 :=
  rfl
#align continuous_multilinear_map.to_multilinear_map_zero ContinuousMultilinearMap.toMultilinearMap_zero

section SMul

variable {R' R'' A : Type _} [Monoid R'] [Monoid R''] [Semiring A] [∀ i, Module A (M₁ i)]
  [Module A M₂] [DistribMulAction R' M₂] [ContinuousConstSMul R' M₂] [SMulCommClass A R' M₂]
  [DistribMulAction R'' M₂] [ContinuousConstSMul R'' M₂] [SMulCommClass A R'' M₂]

instance : SMul R' (ContinuousMultilinearMap A M₁ M₂) :=
  ⟨fun c f => { c • f.toMultilinearMap with cont := f.cont.const_smul c }⟩

@[simp]
theorem smul_apply (f : ContinuousMultilinearMap A M₁ M₂) (c : R') (m : ∀ i, M₁ i) :
    (c • f) m = c • f m :=
  rfl
#align continuous_multilinear_map.smul_apply ContinuousMultilinearMap.smul_apply

@[simp]
theorem toMultilinearMap_smul (c : R') (f : ContinuousMultilinearMap A M₁ M₂) :
    (c • f).toMultilinearMap = c • f.toMultilinearMap :=
  rfl
#align continuous_multilinear_map.to_multilinear_map_smul ContinuousMultilinearMap.toMultilinearMap_smul

instance [SMulCommClass R' R'' M₂] : SMulCommClass R' R'' (ContinuousMultilinearMap A M₁ M₂) :=
  ⟨fun c₁ c₂ f => ext fun x => smul_comm _ _ _⟩

instance [SMul R' R''] [IsScalarTower R' R'' M₂] :
    IsScalarTower R' R'' (ContinuousMultilinearMap A M₁ M₂) :=
  ⟨fun c₁ c₂ f => ext fun x => smul_assoc _ _ _⟩

instance [DistribMulAction R'ᵐᵒᵖ M₂] [IsCentralScalar R' M₂] :
    IsCentralScalar R' (ContinuousMultilinearMap A M₁ M₂) :=
  ⟨fun c₁ f => ext fun x => op_smul_eq_smul _ _⟩

instance : MulAction R' (ContinuousMultilinearMap A M₁ M₂) :=
  Function.Injective.mulAction toMultilinearMap toMultilinearMap_inj fun _ _ => rfl

end SMul

section ContinuousAdd

variable [ContinuousAdd M₂]

instance : Add (ContinuousMultilinearMap R M₁ M₂) :=
  ⟨fun f f' => ⟨f.toMultilinearMap + f'.toMultilinearMap, f.cont.add f'.cont⟩⟩

@[simp]
theorem add_apply (m : ∀ i, M₁ i) : (f + f') m = f m + f' m :=
  rfl
#align continuous_multilinear_map.add_apply ContinuousMultilinearMap.add_apply

@[simp]
theorem toMultilinearMap_add (f g : ContinuousMultilinearMap R M₁ M₂) :
    (f + g).toMultilinearMap = f.toMultilinearMap + g.toMultilinearMap :=
  rfl
#align continuous_multilinear_map.to_multilinear_map_add ContinuousMultilinearMap.toMultilinearMap_add

instance addCommMonoid : AddCommMonoid (ContinuousMultilinearMap R M₁ M₂) :=
  toMultilinearMap_inj.AddCommMonoid _ rfl (fun _ _ => rfl) fun _ _ => rfl
#align continuous_multilinear_map.add_comm_monoid ContinuousMultilinearMap.addCommMonoid

/-- Evaluation of a `continuous_multilinear_map` at a vector as an `add_monoid_hom`. -/
def applyAddHom (m : ∀ i, M₁ i) : ContinuousMultilinearMap R M₁ M₂ →+ M₂ :=
  ⟨fun f => f m, rfl, fun _ _ => rfl⟩
#align continuous_multilinear_map.apply_add_hom ContinuousMultilinearMap.applyAddHom

@[simp]
theorem sum_apply {α : Type _} (f : α → ContinuousMultilinearMap R M₁ M₂) (m : ∀ i, M₁ i)
    {s : Finset α} : (∑ a in s, f a) m = ∑ a in s, f a m :=
  (applyAddHom m).map_sum f s
#align continuous_multilinear_map.sum_apply ContinuousMultilinearMap.sum_apply

end ContinuousAdd

/-- If `f` is a continuous multilinear map, then `f.to_continuous_linear_map m i` is the continuous
linear map obtained by fixing all coordinates but `i` equal to those of `m`, and varying the
`i`-th coordinate. -/
def toContinuousLinearMap [DecidableEq ι] (m : ∀ i, M₁ i) (i : ι) : M₁ i →L[R] M₂ :=
  { f.toMultilinearMap.toLinearMap m i with
    cont := f.cont.comp (continuous_const.update i continuous_id) }
#align continuous_multilinear_map.to_continuous_linear_map ContinuousMultilinearMap.toContinuousLinearMap

/-- The cartesian product of two continuous multilinear maps, as a continuous multilinear map. -/
def prod (f : ContinuousMultilinearMap R M₁ M₂) (g : ContinuousMultilinearMap R M₁ M₃) :
    ContinuousMultilinearMap R M₁ (M₂ × M₃) :=
  { f.toMultilinearMap.Prod g.toMultilinearMap with cont := f.cont.prod_mk g.cont }
#align continuous_multilinear_map.prod ContinuousMultilinearMap.prod

@[simp]
theorem prod_apply (f : ContinuousMultilinearMap R M₁ M₂) (g : ContinuousMultilinearMap R M₁ M₃)
    (m : ∀ i, M₁ i) : (f.Prod g) m = (f m, g m) :=
  rfl
#align continuous_multilinear_map.prod_apply ContinuousMultilinearMap.prod_apply

/-- Combine a family of continuous multilinear maps with the same domain and codomains `M' i` into a
continuous multilinear map taking values in the space of functions `Π i, M' i`. -/
def pi {ι' : Type _} {M' : ι' → Type _} [∀ i, AddCommMonoid (M' i)] [∀ i, TopologicalSpace (M' i)]
    [∀ i, Module R (M' i)] (f : ∀ i, ContinuousMultilinearMap R M₁ (M' i)) :
    ContinuousMultilinearMap R M₁ (∀ i, M' i)
    where
  cont := continuous_pi fun i => (f i).coe_continuous
  toMultilinearMap := MultilinearMap.pi fun i => (f i).toMultilinearMap
#align continuous_multilinear_map.pi ContinuousMultilinearMap.pi

@[simp]
theorem coe_pi {ι' : Type _} {M' : ι' → Type _} [∀ i, AddCommMonoid (M' i)]
    [∀ i, TopologicalSpace (M' i)] [∀ i, Module R (M' i)]
    (f : ∀ i, ContinuousMultilinearMap R M₁ (M' i)) : ⇑(pi f) = fun m j => f j m :=
  rfl
#align continuous_multilinear_map.coe_pi ContinuousMultilinearMap.coe_pi

theorem pi_apply {ι' : Type _} {M' : ι' → Type _} [∀ i, AddCommMonoid (M' i)]
    [∀ i, TopologicalSpace (M' i)] [∀ i, Module R (M' i)]
    (f : ∀ i, ContinuousMultilinearMap R M₁ (M' i)) (m : ∀ i, M₁ i) (j : ι') : pi f m j = f j m :=
  rfl
#align continuous_multilinear_map.pi_apply ContinuousMultilinearMap.pi_apply

section

variable (R M₂)

/-- The evaluation map from `ι → M₂` to `M₂` is multilinear at a given `i` when `ι` is subsingleton.
-/
@[simps toMultilinearMap apply]
def ofSubsingleton [Subsingleton ι] (i' : ι) : ContinuousMultilinearMap R (fun _ : ι => M₂) M₂
    where
  toMultilinearMap := MultilinearMap.ofSubsingleton R _ i'
  cont := continuous_apply _
#align continuous_multilinear_map.of_subsingleton ContinuousMultilinearMap.ofSubsingleton

variable (M₁) {M₂}

/-- The constant map is multilinear when `ι` is empty. -/
@[simps toMultilinearMap apply]
def constOfIsEmpty [IsEmpty ι] (m : M₂) : ContinuousMultilinearMap R M₁ M₂
    where
  toMultilinearMap := MultilinearMap.constOfIsEmpty R _ m
  cont := continuous_const
#align continuous_multilinear_map.const_of_is_empty ContinuousMultilinearMap.constOfIsEmpty

end

/-- If `g` is continuous multilinear and `f` is a collection of continuous linear maps,
then `g (f₁ m₁, ..., fₙ mₙ)` is again a continuous multilinear map, that we call
`g.comp_continuous_linear_map f`. -/
def compContinuousLinearMap (g : ContinuousMultilinearMap R M₁' M₄)
    (f : ∀ i : ι, M₁ i →L[R] M₁' i) : ContinuousMultilinearMap R M₁ M₄ :=
  { g.toMultilinearMap.compLinearMap fun i => (f i).toLinearMap with
    cont := g.cont.comp <| continuous_pi fun j => (f j).cont.comp <| continuous_apply _ }
#align continuous_multilinear_map.comp_continuous_linear_map ContinuousMultilinearMap.compContinuousLinearMap

@[simp]
theorem compContinuousLinearMap_apply (g : ContinuousMultilinearMap R M₁' M₄)
    (f : ∀ i : ι, M₁ i →L[R] M₁' i) (m : ∀ i, M₁ i) :
    g.compContinuousLinearMap f m = g fun i => f i <| m i :=
  rfl
#align continuous_multilinear_map.comp_continuous_linear_map_apply ContinuousMultilinearMap.compContinuousLinearMap_apply

/-- Composing a continuous multilinear map with a continuous linear map gives again a
continuous multilinear map. -/
def ContinuousLinearMap.compContinuousMultilinearMap (g : M₂ →L[R] M₃)
    (f : ContinuousMultilinearMap R M₁ M₂) : ContinuousMultilinearMap R M₁ M₃ :=
  { g.toLinearMap.compMultilinearMap f.toMultilinearMap with cont := g.cont.comp f.cont }
#align continuous_linear_map.comp_continuous_multilinear_map ContinuousLinearMap.compContinuousMultilinearMap

@[simp]
theorem ContinuousLinearMap.compContinuousMultilinearMap_coe (g : M₂ →L[R] M₃)
    (f : ContinuousMultilinearMap R M₁ M₂) :
    (g.compContinuousMultilinearMap f : (∀ i, M₁ i) → M₃) =
      (g : M₂ → M₃) ∘ (f : (∀ i, M₁ i) → M₂) :=
  by
  ext m
  rfl
#align continuous_linear_map.comp_continuous_multilinear_map_coe ContinuousLinearMap.compContinuousMultilinearMap_coe

/-- `continuous_multilinear_map.pi` as an `equiv`. -/
@[simps]
def piEquiv {ι' : Type _} {M' : ι' → Type _} [∀ i, AddCommMonoid (M' i)]
    [∀ i, TopologicalSpace (M' i)] [∀ i, Module R (M' i)] :
    (∀ i, ContinuousMultilinearMap R M₁ (M' i)) ≃ ContinuousMultilinearMap R M₁ (∀ i, M' i)
    where
  toFun := ContinuousMultilinearMap.pi
  invFun f i := (ContinuousLinearMap.proj i : _ →L[R] M' i).compContinuousMultilinearMap f
  left_inv f := by
    ext
    rfl
  right_inv f := by
    ext
    rfl
#align continuous_multilinear_map.pi_equiv ContinuousMultilinearMap.piEquiv

/-- In the specific case of continuous multilinear maps on spaces indexed by `fin (n+1)`, where one
can build an element of `Π(i : fin (n+1)), M i` using `cons`, one can express directly the
additivity of a multilinear map along the first variable. -/
theorem cons_add (f : ContinuousMultilinearMap R M M₂) (m : ∀ i : Fin n, M i.succ) (x y : M 0) :
    f (cons (x + y) m) = f (cons x m) + f (cons y m) :=
  f.toMultilinearMap.cons_add m x y
#align continuous_multilinear_map.cons_add ContinuousMultilinearMap.cons_add

/-- In the specific case of continuous multilinear maps on spaces indexed by `fin (n+1)`, where one
can build an element of `Π(i : fin (n+1)), M i` using `cons`, one can express directly the
multiplicativity of a multilinear map along the first variable. -/
theorem cons_smul (f : ContinuousMultilinearMap R M M₂) (m : ∀ i : Fin n, M i.succ) (c : R)
    (x : M 0) : f (cons (c • x) m) = c • f (cons x m) :=
  f.toMultilinearMap.cons_smul m c x
#align continuous_multilinear_map.cons_smul ContinuousMultilinearMap.cons_smul

theorem map_piecewise_add [DecidableEq ι] (m m' : ∀ i, M₁ i) (t : Finset ι) :
    f (t.piecewise (m + m') m') = ∑ s in t.powerset, f (s.piecewise m m') :=
  f.toMultilinearMap.map_piecewise_add _ _ _
#align continuous_multilinear_map.map_piecewise_add ContinuousMultilinearMap.map_piecewise_add

/-- Additivity of a continuous multilinear map along all coordinates at the same time,
writing `f (m + m')` as the sum  of `f (s.piecewise m m')` over all sets `s`. -/
theorem map_add_univ [DecidableEq ι] [Fintype ι] (m m' : ∀ i, M₁ i) :
    f (m + m') = ∑ s : Finset ι, f (s.piecewise m m') :=
  f.toMultilinearMap.map_add_univ _ _
#align continuous_multilinear_map.map_add_univ ContinuousMultilinearMap.map_add_univ

section ApplySum

open Fintype Finset

variable {α : ι → Type _} [Fintype ι] (g : ∀ i, α i → M₁ i) (A : ∀ i, Finset (α i))

/-- If `f` is continuous multilinear, then `f (Σ_{j₁ ∈ A₁} g₁ j₁, ..., Σ_{jₙ ∈ Aₙ} gₙ jₙ)` is the
sum of `f (g₁ (r 1), ..., gₙ (r n))` where `r` ranges over all functions with `r 1 ∈ A₁`, ...,
`r n ∈ Aₙ`. This follows from multilinearity by expanding successively with respect to each
coordinate. -/
theorem map_sum_finset [DecidableEq ι] :
    (f fun i => ∑ j in A i, g i j) = ∑ r in piFinset A, f fun i => g i (r i) :=
  f.toMultilinearMap.map_sum_finset _ _
#align continuous_multilinear_map.map_sum_finset ContinuousMultilinearMap.map_sum_finset

/-- If `f` is continuous multilinear, then `f (Σ_{j₁} g₁ j₁, ..., Σ_{jₙ} gₙ jₙ)` is the sum of
`f (g₁ (r 1), ..., gₙ (r n))` where `r` ranges over all functions `r`. This follows from
multilinearity by expanding successively with respect to each coordinate. -/
theorem map_sum [DecidableEq ι] [∀ i, Fintype (α i)] :
    (f fun i => ∑ j, g i j) = ∑ r : ∀ i, α i, f fun i => g i (r i) :=
  f.toMultilinearMap.map_sum _
#align continuous_multilinear_map.map_sum ContinuousMultilinearMap.map_sum

end ApplySum

section RestrictScalar

variable (R) {A : Type _} [Semiring A] [SMul R A] [∀ i : ι, Module A (M₁ i)] [Module A M₂]
  [∀ i, IsScalarTower R A (M₁ i)] [IsScalarTower R A M₂]

/-- Reinterpret an `A`-multilinear map as an `R`-multilinear map, if `A` is an algebra over `R`
and their actions on all involved modules agree with the action of `R` on `A`. -/
def restrictScalars (f : ContinuousMultilinearMap A M₁ M₂) : ContinuousMultilinearMap R M₁ M₂
    where
  toMultilinearMap := f.toMultilinearMap.restrictScalars R
  cont := f.cont
#align continuous_multilinear_map.restrict_scalars ContinuousMultilinearMap.restrictScalars

@[simp]
theorem coe_restrictScalars (f : ContinuousMultilinearMap A M₁ M₂) : ⇑(f.restrictScalars R) = f :=
  rfl
#align continuous_multilinear_map.coe_restrict_scalars ContinuousMultilinearMap.coe_restrictScalars

end RestrictScalar

end Semiring

section Ring

variable [Ring R] [∀ i, AddCommGroup (M₁ i)] [AddCommGroup M₂] [∀ i, Module R (M₁ i)] [Module R M₂]
  [∀ i, TopologicalSpace (M₁ i)] [TopologicalSpace M₂] (f f' : ContinuousMultilinearMap R M₁ M₂)

@[simp]
theorem map_sub [DecidableEq ι] (m : ∀ i, M₁ i) (i : ι) (x y : M₁ i) :
    f (update m i (x - y)) = f (update m i x) - f (update m i y) :=
  f.toMultilinearMap.map_sub _ _ _ _
#align continuous_multilinear_map.map_sub ContinuousMultilinearMap.map_sub

section TopologicalAddGroup

variable [TopologicalAddGroup M₂]

instance : Neg (ContinuousMultilinearMap R M₁ M₂) :=
  ⟨fun f => { -f.toMultilinearMap with cont := f.cont.neg }⟩

@[simp]
theorem neg_apply (m : ∀ i, M₁ i) : (-f) m = -f m :=
  rfl
#align continuous_multilinear_map.neg_apply ContinuousMultilinearMap.neg_apply

instance : Sub (ContinuousMultilinearMap R M₁ M₂) :=
  ⟨fun f g => { f.toMultilinearMap - g.toMultilinearMap with cont := f.cont.sub g.cont }⟩

@[simp]
theorem sub_apply (m : ∀ i, M₁ i) : (f - f') m = f m - f' m :=
  rfl
#align continuous_multilinear_map.sub_apply ContinuousMultilinearMap.sub_apply

instance : AddCommGroup (ContinuousMultilinearMap R M₁ M₂) :=
  toMultilinearMap_inj.AddCommGroup _ rfl (fun _ _ => rfl) (fun _ => rfl) (fun _ _ => rfl)
    (fun _ _ => rfl) fun _ _ => rfl

end TopologicalAddGroup

end Ring

section CommSemiring

variable [CommSemiring R] [∀ i, AddCommMonoid (M₁ i)] [AddCommMonoid M₂] [∀ i, Module R (M₁ i)]
  [Module R M₂] [∀ i, TopologicalSpace (M₁ i)] [TopologicalSpace M₂]
  (f : ContinuousMultilinearMap R M₁ M₂)

theorem map_piecewise_smul [DecidableEq ι] (c : ι → R) (m : ∀ i, M₁ i) (s : Finset ι) :
    f (s.piecewise (fun i => c i • m i) m) = (∏ i in s, c i) • f m :=
  f.toMultilinearMap.map_piecewise_smul _ _ _
#align continuous_multilinear_map.map_piecewise_smul ContinuousMultilinearMap.map_piecewise_smul

/-- Multiplicativity of a continuous multilinear map along all coordinates at the same time,
writing `f (λ i, c i • m i)` as `(∏ i, c i) • f m`. -/
theorem map_smul_univ [Fintype ι] (c : ι → R) (m : ∀ i, M₁ i) :
    (f fun i => c i • m i) = (∏ i, c i) • f m :=
  f.toMultilinearMap.map_smul_univ _ _
#align continuous_multilinear_map.map_smul_univ ContinuousMultilinearMap.map_smul_univ

end CommSemiring

section DistribMulAction

variable {R' R'' A : Type _} [Monoid R'] [Monoid R''] [Semiring A] [∀ i, AddCommMonoid (M₁ i)]
  [AddCommMonoid M₂] [∀ i, TopologicalSpace (M₁ i)] [TopologicalSpace M₂] [∀ i, Module A (M₁ i)]
  [Module A M₂] [DistribMulAction R' M₂] [ContinuousConstSMul R' M₂] [SMulCommClass A R' M₂]
  [DistribMulAction R'' M₂] [ContinuousConstSMul R'' M₂] [SMulCommClass A R'' M₂]

instance [ContinuousAdd M₂] : DistribMulAction R' (ContinuousMultilinearMap A M₁ M₂) :=
  Function.Injective.distribMulAction
    ⟨toMultilinearMap, toMultilinearMap_zero, toMultilinearMap_add⟩ toMultilinearMap_inj fun _ _ =>
    rfl

end DistribMulAction

section Module

variable {R' A : Type _} [Semiring R'] [Semiring A] [∀ i, AddCommMonoid (M₁ i)] [AddCommMonoid M₂]
  [∀ i, TopologicalSpace (M₁ i)] [TopologicalSpace M₂] [ContinuousAdd M₂] [∀ i, Module A (M₁ i)]
  [Module A M₂] [Module R' M₂] [ContinuousConstSMul R' M₂] [SMulCommClass A R' M₂]

/-- The space of continuous multilinear maps over an algebra over `R` is a module over `R`, for the
pointwise addition and scalar multiplication. -/
instance : Module R' (ContinuousMultilinearMap A M₁ M₂) :=
  Function.Injective.module _ ⟨toMultilinearMap, toMultilinearMap_zero, toMultilinearMap_add⟩
    toMultilinearMap_inj fun _ _ => rfl

/-- Linear map version of the map `to_multilinear_map` associating to a continuous multilinear map
the corresponding multilinear map. -/
@[simps]
def toMultilinearMapLinear : ContinuousMultilinearMap A M₁ M₂ →ₗ[R'] MultilinearMap A M₁ M₂
    where
  toFun := toMultilinearMap
  map_add' := toMultilinearMap_add
  map_smul' := toMultilinearMap_smul
#align continuous_multilinear_map.to_multilinear_map_linear ContinuousMultilinearMap.toMultilinearMapLinear

/-- `continuous_multilinear_map.pi` as a `linear_equiv`. -/
@[simps (config := { simpRhs := true })]
def piLinearEquiv {ι' : Type _} {M' : ι' → Type _} [∀ i, AddCommMonoid (M' i)]
    [∀ i, TopologicalSpace (M' i)] [∀ i, ContinuousAdd (M' i)] [∀ i, Module R' (M' i)]
    [∀ i, Module A (M' i)] [∀ i, SMulCommClass A R' (M' i)] [∀ i, ContinuousConstSMul R' (M' i)] :
    (∀ i, ContinuousMultilinearMap A M₁ (M' i)) ≃ₗ[R'] ContinuousMultilinearMap A M₁ (∀ i, M' i) :=
  { piEquiv with
    map_add' := fun x y => rfl
    map_smul' := fun c x => rfl }
#align continuous_multilinear_map.pi_linear_equiv ContinuousMultilinearMap.piLinearEquiv

end Module

section CommAlgebra

variable (R ι) (A : Type _) [Fintype ι] [CommSemiring R] [CommSemiring A] [Algebra R A]
  [TopologicalSpace A] [ContinuousMul A]

/-- The continuous multilinear map on `A^ι`, where `A` is a normed commutative algebra
over `𝕜`, associating to `m` the product of all the `m i`.

See also `continuous_multilinear_map.mk_pi_algebra_fin`. -/
protected def mkPiAlgebra : ContinuousMultilinearMap R (fun i : ι => A) A
    where
  cont := continuous_finset_prod _ fun i hi => continuous_apply _
  toMultilinearMap := MultilinearMap.mkPiAlgebra R ι A
#align continuous_multilinear_map.mk_pi_algebra ContinuousMultilinearMap.mkPiAlgebra

@[simp]
theorem mkPiAlgebra_apply (m : ι → A) : ContinuousMultilinearMap.mkPiAlgebra R ι A m = ∏ i, m i :=
  rfl
#align continuous_multilinear_map.mk_pi_algebra_apply ContinuousMultilinearMap.mkPiAlgebra_apply

end CommAlgebra

section Algebra

variable (R n) (A : Type _) [CommSemiring R] [Semiring A] [Algebra R A] [TopologicalSpace A]
  [ContinuousMul A]

/-- The continuous multilinear map on `A^n`, where `A` is a normed algebra over `𝕜`, associating to
`m` the product of all the `m i`.

See also: `continuous_multilinear_map.mk_pi_algebra`. -/
protected def mkPiAlgebraFin : A[×n]→L[R] A
    where
  cont := by
    change Continuous fun m => (List.ofFn m).Prod
    simp_rw [List.ofFn_eq_map]
    exact continuous_list_prod _ fun i hi => continuous_apply _
  toMultilinearMap := MultilinearMap.mkPiAlgebraFin R n A
#align continuous_multilinear_map.mk_pi_algebra_fin ContinuousMultilinearMap.mkPiAlgebraFin

variable {R n A}

@[simp]
theorem mkPiAlgebraFin_apply (m : Fin n → A) :
    ContinuousMultilinearMap.mkPiAlgebraFin R n A m = (List.ofFn m).Prod :=
  rfl
#align continuous_multilinear_map.mk_pi_algebra_fin_apply ContinuousMultilinearMap.mkPiAlgebraFin_apply

end Algebra

section SmulRight

variable [CommSemiring R] [∀ i, AddCommMonoid (M₁ i)] [AddCommMonoid M₂] [∀ i, Module R (M₁ i)]
  [Module R M₂] [TopologicalSpace R] [∀ i, TopologicalSpace (M₁ i)] [TopologicalSpace M₂]
  [ContinuousSMul R M₂] (f : ContinuousMultilinearMap R M₁ R) (z : M₂)

/-- Given a continuous `R`-multilinear map `f` taking values in `R`, `f.smul_right z` is the
continuous multilinear map sending `m` to `f m • z`. -/
@[simps toMultilinearMap apply]
def smulRight : ContinuousMultilinearMap R M₁ M₂
    where
  toMultilinearMap := f.toMultilinearMap.smul_right z
  cont := f.cont.smul continuous_const
#align continuous_multilinear_map.smul_right ContinuousMultilinearMap.smulRight

end SmulRight

end ContinuousMultilinearMap


/-
Copyright (c) 2019 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Daniel Selsam

Proving equalities in fields, building on:

1. https://github.com/coq/coq/blob/master/plugins/setoid_ring/Field_theory.v
-/
import Init.Data.Nat
import Init.Data.Int
import Init.Data.Array
import Init.Control.EState
import Geo.Util
import Geo.Background.Array
import Geo.Arith.CRing

namespace Arith

universe u

-- TODO: notation for inv
class HasInv (α : Type u) :=
(inv : α → α)

open HasInv

class Field (α : Type u) extends CRing α, HasDiv α, HasInv α :=
(oneNotEqZero : (1 : α) ≠ (0 : α))
(divDef       : ∀ (x y : α), x / y = x * inv y)
(invCancel    : ∀ (x : α), x ≠ 0 → x * inv x = 1)

inductive FExpr : Type
| atom : Nat → FExpr
| nat  : Nat → FExpr
| add  : FExpr → FExpr → FExpr
| mul  : FExpr → FExpr → FExpr
| sub  : FExpr → FExpr → FExpr
| div  : FExpr → FExpr → FExpr
| neg  : FExpr → FExpr
| inv  : FExpr → FExpr
| pow  : FExpr → Nat → FExpr

namespace FExpr

def hasToString : FExpr → String
| atom x => "#" ++ toString x
| nat n  => toString n
| add e₁ e₂ => "(add " ++ hasToString e₁ ++ " " ++ hasToString e₂ ++ ")"
| mul e₁ e₂ => "(mul " ++ hasToString e₁ ++ " " ++ hasToString e₂ ++ ")"
| div e₁ e₂ => "(div " ++ hasToString e₁ ++ " " ++ hasToString e₂ ++ ")"
| sub e₁ e₂ => "(sub " ++ hasToString e₁ ++ " " ++ hasToString e₂ ++ ")"
| inv e     => "(inv " ++ hasToString e ++ ")"
| neg e     => "(neg " ++ hasToString e ++ ")"
| pow e k   => "(pow " ++ hasToString e ++ " " ++ toString k ++ ")"

instance : HasToString FExpr := ⟨hasToString⟩
instance : HasRepr FExpr := ⟨hasToString⟩
instance : HasOfNat FExpr   := ⟨nat⟩
instance : HasAdd FExpr     := ⟨add⟩
instance : HasMul FExpr     := ⟨mul⟩
instance : HasSub FExpr     := ⟨sub⟩
instance : HasPow FExpr Nat := ⟨pow⟩
instance : HasNeg FExpr     := ⟨neg⟩
instance : HasDiv FExpr     := ⟨div⟩
instance : HasInv FExpr     := ⟨inv⟩

def denote {α : Type u} [Field α] (xs : Array α) : FExpr → α
| atom x  => xs.get! x
| nat n   => ofNat α n
| add x y => denote x + denote y
| mul x y => denote x * denote y
| div x y => denote x / denote y
| sub x y => denote x - denote y
| pow x k => (denote x)^k
| inv x   => HasInv.inv (denote x)
| neg x   => - (denote x)

end FExpr

structure FieldNF : Type :=
(numer      : CRExpr)
(denom      : CRExpr := 1)
(conditions : Array CRExpr := #[])

namespace FieldNF

variables {α : Type u} [Field α]

def denote (xs : Array α) (nf : FieldNF) : α :=
(nf.numer.denote xs) / (nf.denom.denote xs)

def denoteConditions (xs : Array α) (nf : FieldNF) : Prop :=
nf.conditions.allP (λ c => c.denote xs ≠ 0)

instance : Inhabited FieldNF := ⟨{ numer := 1 }⟩
end FieldNF

namespace Normalize

open FExpr

-- TODO: no idea what this does yet
private def defaultIsIn : CRExpr → Nat → CRExpr → Nat → Option (Nat × CRExpr)
| p₁, k₁, p₂, k₂ =>
  if p₁ == p₂ then
    if k₁ < k₂ then some (0, p₂ ^ (k₂ - k₁))
    else if k₂ < k₁ then some (k₁ - k₂, 1)
    else some (0, 1)
  else
    none

theorem defaultIsInOk (p₁ p₂ p₃ : CRExpr) (k₁ k₂ k₃ : Nat) :
  defaultIsIn p₁ k₁ p₂ k₂ = some (k₃, p₃) → CRExpr.denotationsEq (p₂^k₂) (p₁^(k₁ - k₃) * p₃) ∧ k₃ < k₁ :=
WIP

private def isIn : CRExpr → Nat → CRExpr → Nat → Option (Nat × CRExpr)
| p₁, k₁, CRExpr.mul p₃ p₄, k₂ =>
  match isIn p₁ k₁ p₃ k₂ with
  | some (0, p₅) => some (0, p₅ * (p₄ ^ k₂))
  | some (k₃, p₅) =>
    match isIn p₁ k₃ p₄ k₂ with
    | some (k₄, p₆) => some (k₄, p₅ * p₆)
    | none => some (k₃, p₅ * p₄^k₂)
  | none =>
    match isIn p₁ k₁ p₄ k₂ with
    | some (k₃, p₅) => some (k₃, p₅ * (p₃ ^ k₂))
    | none => none
| p₁, k₁, CRExpr.pow p₃ 0, k₂ => none
| p₁, k₁, CRExpr.pow p₃ k₃, k₂ => isIn p₁ k₁ p₃ (k₂ * k₃)
| p₁, k₁, p₂, k₂ => defaultIsIn p₁ k₁ p₂ k₂

theorem isInOk (p₁ p₂ p₃ : CRExpr) (k₁ k₂ k₃: Nat) :
  isIn p₁ k₁ p₂ k₂ = some (k₃, p₃) → CRExpr.denotationsEq (p₂^k₂) (p₁^(k₁ - k₃) * p₃) :=
WIP

structure Split : Type :=
(left common right : CRExpr)

-- TODO: temporary, to support the panic
instance SplitInhabited : Inhabited Split := ⟨⟨0, 0, 0⟩⟩

private def splitAux : CRExpr → Nat → CRExpr → Split
| CRExpr.mul p₃ p₄, k, p₂ =>
  let s₁ := splitAux p₃ k p₂;
  let s₂ := splitAux p₄ k s₁.right;
  { left   := s₁.left * s₂.left,
    common := s₁.common * s₂.common,
    right  := s₂.right }
| CRExpr.pow p₃ 0,  _, p₂ => ⟨1, 1, p₂⟩
| CRExpr.pow p₃ k₃, k, p₂ => splitAux p₃ (k₃ * k) p₂
| p₁, k, p₂ =>
  match isIn p₁ k p₂ 1 with
  | some (0, p₃)  => ⟨1, p₁^k, p₃⟩
  | some (k₁, p₃) => ⟨p₁^k₁, p₁^(k-k₁), p₃⟩
  | none          => ⟨p₁^k, 1, p₂⟩

private def split (p₁ p₂ : CRExpr) : Split := splitAux p₁ 1 p₂

theorem splitOk (p₁ p₂ : CRExpr) :
  let s := split p₁ p₂;
  CRExpr.denotationsEq p₁ (s.left * s.common)
  ∧ CRExpr.denotationsEq p₂ (s.right * s.common)
  ∧ p₁ ≠ 0 → s.left ≠ 0
  ∧ p₂ ≠ 0 → s.right ≠ 0 :=
WIP

partial def norm : FExpr → FieldNF
| atom x  => { numer := CRExpr.atom x }
| nat n   => { numer := CRExpr.nat n }
| add x y =>
  let (x, y) := (norm x, norm y);
  let s := split x.denom y.denom;
  { numer := x.numer * s.right + y.numer * s.left,
    denom := s.left * s.right * s.common,
    conditions := x.conditions.append y.conditions }
| sub x y => norm $ x + (- y)
| mul x y =>
  let (x, y) := (norm x, norm y);
  let s₁ := split x.numer y.denom;
  let s₂ := split y.numer x.denom;
  { numer := s₁.left * s₂.left,
    denom := s₂.right * s₁.right,
    conditions := x.conditions.append y.conditions }
| neg x => let x := norm x; { numer := - x.numer, .. x }
| inv x =>
  let x := norm x;
  { numer := x.denom, denom := x.numer, conditions := x.conditions.push x.numer }
| div x y => norm (x * FExpr.inv y)
| pow x k => let x := norm x; { numer := x.numer^k, denom := x.denom^k, .. x }

theorem normOk {α : Type u} [Field α] (xs : Array α) (e : FExpr) :
  (norm e).denoteConditions xs → (norm e).denote xs = e.denote xs :=
WIP

end Normalize

def FExpr.norm : FExpr → FieldNF := @Normalize.norm

theorem FieldCorrect {α : Type u} [Field α] (xs : Array α) (e₁ e₂ : FExpr) :
  e₁.norm.denoteConditions xs →
  e₂.norm.denoteConditions xs →
  e₁.norm = e₂.norm → e₁.denote xs = e₂.denote xs :=
WIP

end Arith


import linear_algebra.matrix.to_lin
import data.matrix.kronecker
import algebra.category.FinVect
import kassel.lemma.coevaluation

namespace kassel

variables
  {K: Type*} [field K]

open_locale matrix big_operators

section lemmas

variables
  {α: Type*} [fintype α] [decidable_eq α]
  {s t: finset α}

lemma ite_eq_comm (x y: α) {a b: K}: ite (x = y) a b = ite (y = x) a b :=
begin
  cases (em (x = y)) with h; simp [h], simp [ne_comm.mp h],
end

lemma matrix.one_apply' {n: Type*} [fintype n] [decidable_eq n] (x y):
  (1: matrix n n K) x y = ite (y = x) 1 0 :=
by rw [matrix.one_apply, ite_eq_comm]

lemma linear_equiv.hom_inv_id' {M N} [add_comm_monoid M] [add_comm_monoid N] [module K M] [module K N] (e: M ≃ₗ[K] N):
  e.to_linear_map ∘ₗ e.symm.to_linear_map = linear_map.id :=
by ext; simp

lemma linear_equiv.to_linear_map_to_fun_eq_to_fun {X Y}
  [add_comm_monoid X] [module K X]
  [add_comm_monoid Y] [module K Y]
  (e: X ≃ₗ[K] Y): (e.to_linear_map: X → Y) = (e: X → Y) :=
by simp

variables
  {M N: Type*}
  [add_comm_group M] [module K M]
  [add_comm_group N] [module K N]
  {m n: Type*}
  [fintype m] (bM: basis m K M)
  [fintype n] (bN: basis n K N)

lemma basis.tensor_product_repr_apply
  (x y x' y'):
  (bM.tensor_product bN).repr (x ⊗ₜ y) (x', y') = ((bM.repr) x) x' * ((bN.repr) y) y' :=
by simp [basis.tensor_product]

lemma pi.basis_fun_apply' {l} [fintype l] [decidable_eq l] (x y: l):
  (pi.basis_fun K l) x y = if (y = x) then 1 else 0 :=
by simp [linear_map.std_basis_apply, function.update_apply]

end lemmas

variable (K)

namespace tensor_product

open_locale kronecker

lemma to_matrix
  {m₁ m₂ n₁ n₂: Type*}
  [fintype m₁] [fintype m₂] [fintype n₁] [fintype n₂]
  [decidable_eq m₁] [decidable_eq m₂] [decidable_eq n₁] [decidable_eq n₂]
  {M₁ M₂ N₁ N₂: Type*}
  [add_comm_group M₁] [module K M₁] (a₁: basis m₁ K M₁)
  [add_comm_group M₂] [module K M₂] (a₂: basis m₂ K M₂)
  [add_comm_group N₁] [module K N₁] (b₁: basis n₁ K N₁)
  [add_comm_group N₂] [module K N₂] (b₂: basis n₂ K N₂)
  (f₁: M₁ →ₗ[K] N₁)
  (f₂: M₂ →ₗ[K] N₂):
  linear_map.to_matrix
    (basis.tensor_product a₁ a₂)
    (basis.tensor_product b₁ b₂)
    (tensor_product.map f₁ f₂) =
  linear_map.to_matrix a₁ b₁ f₁ ⊗ₖ linear_map.to_matrix a₂ b₂ f₂ :=
begin
  ext ⟨i₁, i₂⟩ ⟨j₁, j₂⟩,
  rw matrix.kronecker_apply,
  simp_rw linear_map.to_matrix_apply,
  rw basis.tensor_product_apply,
  rw tensor_product.map_tmul,
  rw basis.tensor_product_repr_apply,
end

end tensor_product

namespace associator

variables
  {l m n: Type*}
  [fintype l] [fintype m] [fintype n]
  [decidable_eq l] [decidable_eq m] [decidable_eq n]
  (L M N: Type*)
  [add_comm_group L] [module K L] (bL: basis l K L)
  [add_comm_group M] [module K M] (bM: basis m K M)
  [add_comm_group N] [module K N] (bN: basis n K N)

abbreviation hom := (tensor_product.assoc K L M N).to_linear_map
abbreviation inv := (tensor_product.assoc K L M N).symm.to_linear_map

@[simp] def hom_matrix: matrix (l × (m × n)) ((l × m) × n) K
| (a₁, (b₁, c₁)) ((a₂, b₂), c₂) :=
  (ite (a₂ = a₁) 1 0) * (ite (b₂ = b₁) 1 0) * (ite (c₂ = c₁) 1 0)

@[simp] def inv_matrix: matrix ((l × m) × n) (l × (m × n)) K
| ((a₁, b₁), c₁) (a₂, (b₂, c₂)) :=
  (ite (a₂ = a₁) 1 0) * (ite (b₂ = b₁) 1 0) * (ite (c₂ = c₁) 1 0)

lemma hom_to_matrix:
  linear_map.to_matrix
    ((bL.tensor_product bM).tensor_product bN)
    (bL.tensor_product (bM.tensor_product bN))
    (hom K L M N) =
  hom_matrix K :=
begin
  ext ⟨i₁, ⟨j₁, k₁⟩⟩ ⟨⟨i₂, j₂⟩, k₂⟩,
  rw linear_map.to_matrix_apply,
  simp_rw basis.tensor_product_apply,
  rw [linear_equiv.to_linear_map_to_fun_eq_to_fun, tensor_product.assoc_tmul, hom_matrix],
  simp_rw basis.tensor_product_repr_apply,
  simp_rw [basis.repr_self_apply, mul_assoc],
end

lemma inv_to_matrix:
  linear_map.to_matrix
    (bL.tensor_product (bM.tensor_product bN))
    ((bL.tensor_product bM).tensor_product bN)
    (inv K L M N) =
  inv_matrix K :=
begin
  ext ⟨⟨i₁, j₁⟩, k₁⟩ ⟨i₂, ⟨j₂, k₂⟩⟩,
  rw linear_map.to_matrix_apply,
  simp_rw basis.tensor_product_apply,
  rw [linear_equiv.to_linear_map_to_fun_eq_to_fun, tensor_product.assoc_symm_tmul, inv_matrix],
  simp_rw basis.tensor_product_repr_apply,
  simp_rw basis.repr_self_apply,
end

lemma hom_matrix_reindex {o}
  (A: matrix ((l × m) × n) o K):
  hom_matrix K ⬝ A = matrix.reindex (equiv.prod_assoc l m n) (equiv.refl o) A :=
begin
  ext ⟨x, ⟨y, z⟩⟩ w,
  rw matrix.mul_apply,
  rw sum_nonzero (finset.subset_univ {((x, y), z)}) (λ (j: (l × m) × n), _),
  rw finset.sum_singleton, simp,
  rintro ⟨⟨x', y'⟩, z'⟩, simp, tauto,
end

lemma inv_matrix_reindex {o}
  (A: matrix (l × (m × n)) o K):
  inv_matrix K ⬝ A = matrix.reindex (equiv.prod_assoc l m n).symm (equiv.refl o) A :=
begin
  ext ⟨⟨x, y⟩, z⟩ w,
  rw matrix.mul_apply,
  rw sum_nonzero (finset.subset_univ {(x, (y, z))}) (λ (j: l × (m × n)), _),
  rw finset.sum_singleton, simp,
  rintro ⟨x', ⟨y', z'⟩⟩, simp, tauto,
end

lemma hom_matrix_reindex_assoc {o p}
  (A: matrix ((l × m) × n) o K) (B: matrix p (l × (m × n)) K):
  (B ⬝ hom_matrix K) ⬝ A = B ⬝ matrix.reindex (equiv.prod_assoc l m n) (equiv.refl o) A :=
begin
  rw [matrix.mul_assoc, hom_matrix_reindex],
end

lemma inv_matrix_reindex_assoc {o p}
  (A: matrix (l × (m × n)) o K) (B: matrix p ((l × m) × n) K):
  (B ⬝ inv_matrix K) ⬝ A = B ⬝ matrix.reindex (equiv.prod_assoc l m n).symm (equiv.refl o) A :=
begin
  rw [matrix.mul_assoc, inv_matrix_reindex],
end

end associator

namespace right_unitor

variables
  (M: Type*) [add_comm_group M] [module K M]
  (m: Type*) [fintype m] [decidable_eq m]
  (bM: basis m K M)

abbreviation hom := (tensor_product.rid K M).to_linear_map
abbreviation inv := (tensor_product.rid K M).symm.to_linear_map

@[simp] def hom_matrix: matrix m (m × unit) K
  | x (y, star) := ite (y = x) 1 0

@[simp] def inv_matrix: matrix (m × unit) m K
  | (x, star) y := ite (y = x) 1 0

lemma hom_to_matrix:
  linear_map.to_matrix
    (bM.tensor_product (basis.singleton unit K)) bM (hom K M) =
  hom_matrix K m :=
begin
  ext i ⟨j, star⟩,
  rw linear_map.to_matrix_apply,
  rw basis.tensor_product_apply,
  rw [linear_equiv.to_linear_map_to_fun_eq_to_fun, tensor_product.rid_tmul, hom_matrix],
  rw [basis.singleton_apply, one_smul, basis.repr_self_apply],
end

lemma inv_to_matrix:
  linear_map.to_matrix
    bM (bM.tensor_product (basis.singleton unit K)) (inv K M) =
  inv_matrix K m :=
begin
  ext ⟨i, star⟩ j,
  rw linear_map.to_matrix_apply,
  rw [linear_equiv.to_linear_map_to_fun_eq_to_fun, tensor_product.rid_symm_apply, inv_matrix],
  rw [basis.tensor_product_repr_apply],
  rw [basis.singleton_repr, mul_one, basis.repr_self_apply],
end

lemma hom_matrix_reindex {o}
  (A: matrix (m × unit) o K):
  hom_matrix K m ⬝ A = matrix.reindex (equiv.prod_punit m) (equiv.refl o) A :=
begin
  ext x y,
  rw matrix.mul_apply,
  rw sum_nonzero (finset.subset_univ {(x, unit.star)}) (λ (j: m × unit), _),
  rw finset.sum_singleton, simp,
  rintro ⟨x', star⟩, simp, tauto,
end

lemma inv_matrix_reindex {o}
  (A: matrix m o K):
  inv_matrix K m ⬝ A = matrix.reindex (equiv.prod_punit m).symm (equiv.refl o) A :=
begin
  ext ⟨x, star⟩ y,
  rw matrix.mul_apply,
  rw sum_nonzero (finset.subset_univ {x}) (λ (j: m), _),
  rw finset.sum_singleton, simp,
  intro x', simp, tauto,
end

end right_unitor

namespace left_unitor

variables
  (M: Type*) [add_comm_group M] [module K M]
  (m: Type*) [fintype m] [decidable_eq m]
  (bM: basis m K M)

abbreviation hom := (tensor_product.lid K M).to_linear_map
abbreviation inv := (tensor_product.lid K M).symm.to_linear_map

@[simp] def hom_matrix: matrix m (unit × m) K
  | x (star, y) := ite (y = x) 1 0

@[simp] def inv_matrix: matrix (unit × m) m K
  | (star, x) y := ite (y = x) 1 0

lemma hom_to_matrix:
  linear_map.to_matrix
    ((basis.singleton unit K).tensor_product bM) bM (hom K M) =
  hom_matrix K m :=
begin
  ext i ⟨star, j⟩,
  rw linear_map.to_matrix_apply,
  rw basis.tensor_product_apply,
  rw [linear_equiv.to_linear_map_to_fun_eq_to_fun, tensor_product.lid_tmul, hom_matrix],
  rw [basis.singleton_apply, one_smul, basis.repr_self_apply],
end

lemma inv_to_matrix:
  linear_map.to_matrix
    bM ((basis.singleton unit K).tensor_product bM) (inv K M) =
  inv_matrix K m :=
begin
  ext ⟨i, star⟩ j,
  rw linear_map.to_matrix_apply,
  rw [linear_equiv.to_linear_map_to_fun_eq_to_fun, tensor_product.lid_symm_apply, inv_matrix],
  rw basis.tensor_product_repr_apply,
  rw [basis.singleton_repr, one_mul, basis.repr_self_apply],
end

lemma hom_matrix_reindex {o}
  (A: matrix (unit × m) o K):
  hom_matrix K m ⬝ A = matrix.reindex (equiv.punit_prod m) (equiv.refl o) A :=
begin
  ext x y,
  rw matrix.mul_apply,
  rw sum_nonzero (finset.subset_univ {(unit.star, x)}) (λ (j: unit × m), _),
  rw finset.sum_singleton, simp,
  rintro ⟨star, x'⟩, simp, tauto,
end

lemma inv_matrix_reindex {o}
  (A: matrix m o K):
  inv_matrix K m ⬝ A = matrix.reindex (equiv.punit_prod m).symm (equiv.refl o) A :=
begin
  ext ⟨star, x⟩ y,
  rw matrix.mul_apply,
  rw sum_nonzero (finset.subset_univ {x}) (λ (j: m), _),
  rw finset.sum_singleton, simp,
  intro x', simp, tauto,
end

end left_unitor

namespace right_pivotor

variables
  (M: Type*) [add_comm_group M] [module K M] [finite_dimensional K M]
  (m: Type*) [fintype m] [decidable_eq m] (bM: basis m K M)

noncomputable abbreviation hom := (module.eval_equiv K M).to_linear_map
noncomputable abbreviation inv := (module.eval_equiv K M).symm.to_linear_map

lemma hom_to_matrix:
  linear_map.to_matrix bM bM.dual_basis.dual_basis (hom K M) = 1 :=
begin
  ext x y,
  rw linear_map.to_matrix_apply,
  rw basis.dual_basis_repr,
  dsimp, rw ←linear_equiv.to_linear_map_to_fun_eq_to_fun,
  rw [module.eval_equiv_to_linear_map, module.dual.eval_apply, matrix.one_apply'],
  rw basis.dual_basis_apply_self,
end

lemma inv_to_matrix:
  linear_map.to_matrix bM.dual_basis.dual_basis bM (inv K M) = 1 :=
begin
  rw ←one_mul (linear_map.to_matrix _ _ _),
  nth_rewrite 0 ←(hom_to_matrix K M m bM),
  rw [matrix.mul_eq_mul, ←linear_map.to_matrix_comp],
  rw [linear_equiv.hom_inv_id', linear_map.to_matrix_id],
end

end right_pivotor

namespace coevaluation

variables
  (M: Type*) [add_comm_group M] [module K M] [finite_dimensional K M]
  (m: Type*) [fintype m] [decidable_eq m] (bM: basis m K M)

noncomputable abbreviation hom := coevaluation K M
noncomputable abbreviation rev :=
  tensor_product.map linear_map.id (right_pivotor.inv K M) ∘ₗ
  coevaluation K (module.dual K M)

@[simp] def matrix: matrix (m × m) unit K
  | (x, y) star := ite (y = x) 1 0

lemma to_matrix:
  linear_map.to_matrix
    (basis.singleton unit K) (bM.tensor_product bM.dual_basis) (hom K M) =
  matrix K m :=
begin
  ext ⟨x, y⟩ star,
  rw linear_map.to_matrix_apply,
  rw basis.singleton_apply,
  rw [coevaluation_apply_one' bM, matrix],
  rw [map_sum, finsupp.coe_finset_sum, fintype.sum_apply],
  simp_rw basis.tensor_product_repr_apply,
  simp only [basis.repr_self_apply, basis.dual_basis_repr, basis.coord_apply],
  rw sum_nonzero (finset.subset_univ {x}) (λ (x_1: m), _),
  rw finset.sum_singleton, simp,
  intro x', simp, tauto,
end

lemma rev_to_matrix:
  linear_map.to_matrix
    (basis.singleton unit K) (bM.dual_basis.tensor_product bM) (rev K M) =
  matrix K m :=
begin
  rw [
    linear_map.to_matrix_comp _ (bM.dual_basis.tensor_product bM.dual_basis.dual_basis) _,
    tensor_product.to_matrix
  ],
  rw [linear_map.to_matrix_id, right_pivotor.inv_to_matrix, to_matrix],
  rw [matrix.one_kronecker_one, matrix.one_mul],
end

end coevaluation

namespace evaluation

variables
  (M: Type*) [add_comm_group M] [module K M] [finite_dimensional K M]
  (m: Type) [fintype m] [decidable_eq m] (bM: basis m K M)

@[simp] def matrix: matrix unit (m × m) K
  | star (x, y) := ite (y = x) 1 0

abbreviation hom := contract_left K M
noncomputable abbreviation rev :=
  contract_left K (module.dual K M) ∘ₗ
  tensor_product.map (right_pivotor.hom K M) linear_map.id

lemma to_matrix:
  linear_map.to_matrix
    (bM.dual_basis.tensor_product bM)
    (basis.singleton unit K)
    (hom K M) =
  matrix K m :=
begin
  ext star ⟨x, y⟩,
  rw linear_map.to_matrix_apply,
  rw basis.tensor_product_apply,
  rw [contract_left_apply, matrix],
  rw [basis.singleton_repr, basis.dual_basis_apply, basis.repr_self_apply],
end

lemma rev_to_matrix:
  linear_map.to_matrix
    (bM.tensor_product bM.dual_basis)
    (basis.singleton unit K)
    (rev K M) =
  matrix K m :=
begin
  rw [
    linear_map.to_matrix_comp _ (bM.dual_basis.dual_basis.tensor_product bM.dual_basis) _,
    tensor_product.to_matrix
  ],
  rw [linear_map.to_matrix_id, right_pivotor.hom_to_matrix, to_matrix],
  rw [matrix.one_kronecker_one, matrix.mul_one],
end

end evaluation

end kassel


/-
Copyright (c) 2018 Chris Hughes. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Chris Hughes
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.group_theory.group_action.defs
import Mathlib.algebra.group.units
import Mathlib.algebra.group_with_zero.default
import Mathlib.data.equiv.mul_add
import Mathlib.group_theory.perm.basic
import Mathlib.PostPort

universes u v

namespace Mathlib

/-!
# Group actions applied to various types of group

This file contains lemmas about `smul` on `units`, `group_with_zero`, and `group`.
-/

@[simp] theorem units.inv_smul_smul {α : Type u} {β : Type v} [monoid α] [mul_action α β]
    (u : units α) (x : β) : ↑(u⁻¹) • ↑u • x = x :=
  eq.mpr (id (Eq._oldrec (Eq.refl (↑(u⁻¹) • ↑u • x = x)) (smul_smul (↑(u⁻¹)) (↑u) x)))
    (eq.mpr (id (Eq._oldrec (Eq.refl ((↑(u⁻¹) * ↑u) • x = x)) (units.inv_mul u)))
      (eq.mpr (id (Eq._oldrec (Eq.refl (1 • x = x)) (one_smul α x))) (Eq.refl x)))

@[simp] theorem units.smul_inv_smul {α : Type u} {β : Type v} [monoid α] [mul_action α β]
    (u : units α) (x : β) : ↑u • ↑(u⁻¹) • x = x :=
  eq.mpr (id (Eq._oldrec (Eq.refl (↑u • ↑(u⁻¹) • x = x)) (smul_smul (↑u) (↑(u⁻¹)) x)))
    (eq.mpr (id (Eq._oldrec (Eq.refl ((↑u * ↑(u⁻¹)) • x = x)) (units.mul_inv u)))
      (eq.mpr (id (Eq._oldrec (Eq.refl (1 • x = x)) (one_smul α x))) (Eq.refl x)))

/-- If a monoid `α` acts on `β`, then each `u : units α` defines a permutation of `β`. -/
def units.smul_perm_hom {α : Type u} {β : Type v} [monoid α] [mul_action α β] :
    units α →* equiv.perm β :=
  monoid_hom.mk
    (fun (u : units α) =>
      equiv.mk (fun (x : β) => ↑u • x) (fun (x : β) => ↑(u⁻¹) • x) (units.inv_smul_smul u)
        (units.smul_inv_smul u))
    sorry sorry

@[simp] theorem units.smul_left_cancel {α : Type u} {β : Type v} [monoid α] [mul_action α β]
    (u : units α) {x : β} {y : β} : ↑u • x = ↑u • y ↔ x = y :=
  equiv.apply_eq_iff_eq (coe_fn units.smul_perm_hom u)

theorem units.smul_eq_iff_eq_inv_smul {α : Type u} {β : Type v} [monoid α] [mul_action α β]
    (u : units α) {x : β} {y : β} : ↑u • x = y ↔ x = ↑(u⁻¹) • y :=
  equiv.apply_eq_iff_eq_symm_apply (coe_fn units.smul_perm_hom u)

theorem is_unit.smul_left_cancel {α : Type u} {β : Type v} [monoid α] [mul_action α β] {a : α}
    (ha : is_unit a) {x : β} {y : β} : a • x = a • y ↔ x = y :=
  sorry

@[simp] theorem inv_smul_smul' {α : Type u} {β : Type v} [group_with_zero α] [mul_action α β]
    {c : α} (hc : c ≠ 0) (x : β) : c⁻¹ • c • x = x :=
  units.inv_smul_smul (units.mk0 c hc) x

@[simp] theorem smul_inv_smul' {α : Type u} {β : Type v} [group_with_zero α] [mul_action α β]
    {c : α} (hc : c ≠ 0) (x : β) : c • c⁻¹ • x = x :=
  units.smul_inv_smul (units.mk0 c hc) x

theorem inv_smul_eq_iff' {α : Type u} {β : Type v} [group_with_zero α] [mul_action α β] {a : α}
    (ha : a ≠ 0) {x : β} {y : β} : a⁻¹ • x = y ↔ x = a • y :=
  sorry

theorem eq_inv_smul_iff' {α : Type u} {β : Type v} [group_with_zero α] [mul_action α β] {a : α}
    (ha : a ≠ 0) {x : β} {y : β} : x = a⁻¹ • y ↔ a • x = y :=
  sorry

@[simp] theorem inv_smul_smul {α : Type u} {β : Type v} [group α] [mul_action α β] (c : α) (x : β) :
    c⁻¹ • c • x = x :=
  units.inv_smul_smul (coe_fn to_units c) x

@[simp] theorem smul_inv_smul {α : Type u} {β : Type v} [group α] [mul_action α β] (c : α) (x : β) :
    c • c⁻¹ • x = x :=
  units.smul_inv_smul (coe_fn to_units c) x

theorem inv_smul_eq_iff {α : Type u} {β : Type v} [group α] [mul_action α β] {a : α} {x : β}
    {y : β} : a⁻¹ • x = y ↔ x = a • y :=
  sorry

theorem eq_inv_smul_iff {α : Type u} {β : Type v} [group α] [mul_action α β] {a : α} {x : β}
    {y : β} : x = a⁻¹ • y ↔ a • x = y :=
  sorry

/-- Given an action of a group `α` on a set `β`, each `g : α` defines a permutation of `β`. -/
def mul_action.to_perm (α : Type u) (β : Type v) [group α] [mul_action α β] : α →* equiv.perm β :=
  monoid_hom.comp units.smul_perm_hom (mul_equiv.to_monoid_hom to_units)

protected theorem mul_action.bijective {α : Type u} {β : Type v} [group α] [mul_action α β]
    (g : α) : function.bijective fun (b : β) => g • b :=
  equiv.bijective (coe_fn (mul_action.to_perm α β) g)

theorem units.smul_eq_zero {α : Type u} {β : Type v} [monoid α] [add_monoid β]
    [distrib_mul_action α β] (u : units α) {x : β} : ↑u • x = 0 ↔ x = 0 :=
  sorry

theorem units.smul_ne_zero {α : Type u} {β : Type v} [monoid α] [add_monoid β]
    [distrib_mul_action α β] (u : units α) {x : β} : ↑u • x ≠ 0 ↔ x ≠ 0 :=
  not_congr (units.smul_eq_zero u)

@[simp] theorem is_unit.smul_eq_zero {α : Type u} {β : Type v} [monoid α] [add_monoid β]
    [distrib_mul_action α β] {u : α} (hu : is_unit u) {x : β} : u • x = 0 ↔ x = 0 :=
  exists.elim hu fun (u_1 : units α) (hu : ↑u_1 = u) => hu ▸ units.smul_eq_zero u_1

end Mathlib


import SciLean.Core.Hilbert

namespace SciLean

class Basis (X : Type u) (ι : outParam $ Type v) (K : outParam $ Type w) where
  basis : ι → X
  proj  : ι → X → K

class DualBasis (X : Type u) (ι : outParam $ Type v) (K : outParam $ Type w) where
  dualBasis : ι → X
  dualProj  : ι → X → K

class BasisDuality (X : Type u) where
  toDual   : X → X  -- transforms basis vectors to dual basis vectors
  fromDual : X → X  -- transforma dual basis vectors to basis vectors

section Basis

  instance : Basis ℝ Unit ℝ :=
  {
    basis := λ _ => 1
    proj  := λ _ x => x
  }

  instance : DualBasis ℝ Unit ℝ :=
  {
    dualBasis := λ _ => 1
    dualProj  := λ _ x => x
  }

  instance : BasisDuality ℝ :=
  {
    toDual := λ x => x
    fromDual  := λ x => x
  }

  /-- `𝕖 i` is the i-th basis vector -/
  prefix:max "𝕖" => Basis.basis
  /-- `𝕖[X] i` is the i-th basis vector of type `X` -/
  macro:max "𝕖[" X:term "]" i:term : term => `(Basis.basis (X:=$X) $i)

  /-- `𝕖' i` is the i-th dual basis vector -/
  prefix:max "𝕖'" => DualBasis.dualBasis
  /-- `𝕖'[X] i` is the i-th dual basis vector of type `X` -/
  macro:max "𝕖'[" X:term "]" i:term : term => `(DualBasis.dualBasis (X:=$X) $i)

  /-- `𝕡 i x` is projection of `x` onto i-th basis vector `𝕖 i` -/
  prefix:max "𝕡" => Basis.proj
  /-- `𝕡' i x` is projection of `x` onto i-th dual basis vector `𝕖' i` -/
  prefix:max "𝕡'" => DualBasis.dualProj

  instance {X Y ι κ K} [Basis X ι K] [Basis Y κ K] [Zero X] [Zero Y] : Basis (X × Y) (ι ⊕ κ) K where
    basis := λ i =>
      match i with
      | Sum.inl ix => (𝕖 ix, 0)
      | Sum.inr iy => (0, 𝕖 iy)
    proj := λ i x =>
      match i with
      | Sum.inl ix => 𝕡 ix x.1
      | Sum.inr iy => 𝕡 iy x.2

  instance {X Y ι κ K} [DualBasis X ι K] [DualBasis Y κ K] [Zero X] [Zero Y] : DualBasis (X × Y) (ι ⊕ κ) K where
    dualBasis := λ i =>
      match i with
      | Sum.inl ix => (𝕖' ix, 0)
      | Sum.inr iy => (0, 𝕖' iy)
    dualProj := λ i x =>
      match i with
      | Sum.inl ix => 𝕡' ix x.1
      | Sum.inr iy => 𝕡' iy x.2

  instance {X Y} [BasisDuality X] [BasisDuality Y] : BasisDuality (X×Y) where
    toDual := λ (x,y) => (BasisDuality.toDual x, BasisDuality.toDual y)
    fromDual := λ (x,y) => (BasisDuality.fromDual x, BasisDuality.fromDual y)

end Basis

/--
 -/
class FinVec (X : Type) (ι : outParam Type) [outParam $ Enumtype ι] extends Hilbert X, Basis X ι ℝ, DualBasis X ι ℝ, BasisDuality X where
  is_basis : ∀ x : X, x = ∑ i : ι, 𝕡 i x • 𝕖[X] i
  duality : ∀ i j, ⟪𝕖[X] i, 𝕖'[X] j⟫ = [[i=j]]
  to_dual   : toDual   x = ∑ i,  𝕡 i x • 𝕖'[X] i
  from_dual : fromDual x = ∑ i, 𝕡' i x •  𝕖[X] i

theorem basis_ext {X ι} [Enumtype ι] [FinVec X ι] (x y : X)
  : (∀ i, ⟪x, 𝕖 i⟫ = ⟪y, 𝕖 i⟫) → (x = y) := sorry_proof

theorem dualBasis_ext {X ι} [Enumtype ι] [FinVec X ι] (x y : X)
  : (∀ i, ⟪x, 𝕖' i⟫ = ⟪y, 𝕖' i⟫) → (x = y) := sorry_proof

theorem inner_proj_dualProj {X ι} [Enumtype ι] [FinVec X ι] (x y : X)
  : ⟪x, y⟫ = ∑ i, 𝕡 i x * 𝕡' i y :=
by sorry_proof

@[simp]
theorem inner_basis_dualBasis {X ι} [Enumtype ι] [FinVec X ι] (i j : ι)
  : ⟪𝕖[X] i, 𝕖' j⟫ = [[i=j]] :=
by apply FinVec.duality

@[simp]
theorem inner_dualBasis_basis {X ι} [Enumtype ι] [FinVec X ι] (i j : ι)
  : ⟪𝕖'[X] i, 𝕖 j⟫ = [[i=j]] :=
by sorry_proof

@[simp]
theorem inner_dualBasis_proj {X ι} [Enumtype ι] [FinVec X ι] (i : ι) (x : X)
  : ⟪x, 𝕖' i⟫ = 𝕡 i x :=
by sorry_proof

@[simp]
theorem inner_basis_dualProj {X ι} [Enumtype ι] [FinVec X ι] (i : ι) (x : X)
  : ⟪x, 𝕖 i⟫ = 𝕡' i x :=
by sorry_proof

@[simp]
theorem proj_basis {X ι} [Enumtype ι] [FinVec X ι] (i j : ι)
  : 𝕡 i (𝕖[X] j) = [[i=j]] :=
by simp only [←inner_dualBasis_proj, inner_basis_dualBasis, eq_comm]; done

@[simp]
theorem dualProj_dualBasis {X ι} [Enumtype ι] [FinVec X ι] (i j : ι)
  : 𝕡' i (𝕖'[X] j) = [[i=j]] :=
by simp only [←inner_basis_dualProj, inner_dualBasis_basis, eq_comm]; done

instance : FinVec ℝ Unit where
  is_basis := by simp[Basis.proj, Basis.basis]; sorry_proof
  duality := by simp[Basis.proj, Basis.basis, DualBasis.dualProj, DualBasis.dualBasis, Inner.inner]; done
  to_dual := by sorry_proof
  from_dual := by sorry_proof

-- @[infer_tc_goals_rl]
-- instance {X Y ι κ} [Enumtype ι] [Enumtype κ] [FinVec X ι] [FinVec Y κ]
--   : FinVec (X×Y) (ι⊕κ) where
--   is_basis := sorry_proof
--   duality := sorry_proof

opaque foo {X} {ι : Type} [Enumtype ι] [FinVec X ι] (x : X) : X

set_option pp.all true in
#check foo (1 : ℝ)


/-
Copyright (c) 2017 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl
-/
import tactic.basic

/-!
# Extra facts about `prod`

This file defines `prod.swap : α × β → β × α` and proves various simple lemmas about `prod`.
-/

variables {α : Type*} {β : Type*} {γ : Type*} {δ : Type*}

@[simp] lemma prod_map (f : α → γ) (g : β → δ) (p : α × β) : prod.map f g p = (f p.1, g p.2) := rfl

namespace prod

@[simp] theorem «forall» {p : α × β → Prop} : (∀ x, p x) ↔ (∀ a b, p (a, b)) :=
⟨assume h a b, h (a, b), assume h ⟨a, b⟩, h a b⟩

@[simp] theorem «exists» {p : α × β → Prop} : (∃ x, p x) ↔ (∃ a b, p (a, b)) :=
⟨assume ⟨⟨a, b⟩, h⟩, ⟨a, b, h⟩, assume ⟨a, b, h⟩, ⟨⟨a, b⟩, h⟩⟩

theorem forall' {p : α → β → Prop} : (∀ x : α × β, p x.1 x.2) ↔ ∀ a b, p a b :=
prod.forall

theorem exists' {p : α → β → Prop} : (∃ x : α × β, p x.1 x.2) ↔ ∃ a b, p a b :=
prod.exists

@[simp] lemma snd_comp_mk (x : α) : prod.snd ∘ (prod.mk x : β → α × β) = id := rfl

@[simp] lemma fst_comp_mk (x : α) : prod.fst ∘ (prod.mk x : β → α × β) = function.const β x := rfl

@[simp] lemma map_mk (f : α → γ) (g : β → δ) (a : α) (b : β) : map f g (a, b) = (f a, g b) := rfl

lemma map_fst (f : α → γ) (g : β → δ) (p : α × β) : (map f g p).1 = f (p.1) := rfl

lemma map_snd (f : α → γ) (g : β → δ) (p : α × β) : (map f g p).2 = g (p.2) := rfl

lemma map_fst' (f : α → γ) (g : β → δ) : (prod.fst ∘ map f g) = f ∘ prod.fst :=
funext $ map_fst f g

lemma map_snd' (f : α → γ) (g : β → δ) : (prod.snd ∘ map f g) = g ∘ prod.snd :=
funext $ map_snd f g

/--
Composing a `prod.map` with another `prod.map` is equal to
a single `prod.map` of composed functions.
-/
lemma map_comp_map {ε ζ : Type*}
  (f : α → β) (f' : γ → δ) (g : β → ε) (g' : δ → ζ) :
  prod.map g g' ∘ prod.map f f' = prod.map (g ∘ f) (g' ∘ f') :=
rfl

/--
Composing a `prod.map` with another `prod.map` is equal to
a single `prod.map` of composed functions, fully applied.
-/
lemma map_map {ε ζ : Type*}
  (f : α → β) (f' : γ → δ) (g : β → ε) (g' : δ → ζ) (x : α × γ) :
  prod.map g g' (prod.map f f' x) = prod.map (g ∘ f) (g' ∘ f') x :=
rfl

@[simp] theorem mk.inj_iff {a₁ a₂ : α} {b₁ b₂ : β} : (a₁, b₁) = (a₂, b₂) ↔ (a₁ = a₂ ∧ b₁ = b₂) :=
⟨prod.mk.inj, by cc⟩

lemma mk.inj_left {α β : Type*} (a : α) :
  function.injective (prod.mk a : β → α × β) :=
by { intros b₁ b₂ h, simpa only [true_and, prod.mk.inj_iff, eq_self_iff_true] using h }

lemma mk.inj_right {α β : Type*} (b : β) :
  function.injective (λ a, prod.mk a b : α → α × β) :=
by { intros b₁ b₂ h, by simpa only [and_true, eq_self_iff_true, mk.inj_iff] using h }

lemma ext_iff {p q : α × β} : p = q ↔ p.1 = q.1 ∧ p.2 = q.2 :=
by rw [← @mk.eta _ _ p, ← @mk.eta _ _ q, mk.inj_iff]

@[ext]
lemma ext {α β} {p q : α × β} (h₁ : p.1 = q.1) (h₂ : p.2 = q.2) : p = q :=
ext_iff.2 ⟨h₁, h₂⟩

lemma map_def {f : α → γ} {g : β → δ} : prod.map f g = λ (p : α × β), (f p.1, g p.2) :=
funext (λ p, ext (map_fst f g p) (map_snd f g p))

lemma id_prod : (λ (p : α × α), (p.1, p.2)) = id :=
funext $ λ ⟨a, b⟩, rfl

lemma fst_surjective [h : nonempty β] : function.surjective (@fst α β) :=
λ x, h.elim $ λ y, ⟨⟨x, y⟩, rfl⟩

lemma snd_surjective [h : nonempty α] : function.surjective (@snd α β) :=
λ y, h.elim $ λ x, ⟨⟨x, y⟩, rfl⟩

lemma fst_injective [subsingleton β] : function.injective (@fst α β) :=
λ x y h, ext h (subsingleton.elim _ _)

lemma snd_injective [subsingleton α] : function.injective (@snd α β) :=
λ x y h, ext (subsingleton.elim _ _) h

/-- Swap the factors of a product. `swap (a, b) = (b, a)` -/
def swap : α × β → β × α := λp, (p.2, p.1)

@[simp] lemma swap_swap : ∀ x : α × β, swap (swap x) = x
| ⟨a, b⟩ := rfl

@[simp] lemma fst_swap {p : α × β} : (swap p).1 = p.2 := rfl

@[simp] lemma snd_swap {p : α × β} : (swap p).2 = p.1 := rfl

@[simp] lemma swap_prod_mk {a : α} {b : β} : swap (a, b) = (b, a) := rfl

@[simp] lemma swap_swap_eq : swap ∘ swap = @id (α × β) :=
funext swap_swap

@[simp] lemma swap_left_inverse : function.left_inverse (@swap α β) swap :=
swap_swap

@[simp] lemma swap_right_inverse : function.right_inverse (@swap α β) swap :=
swap_swap

lemma swap_injective : function.injective (@swap α β) :=
swap_left_inverse.injective

lemma swap_surjective : function.surjective (@swap α β) :=
swap_left_inverse.surjective

lemma swap_bijective : function.bijective (@swap α β) :=
⟨swap_injective, swap_surjective⟩

@[simp] lemma swap_inj {p q : α × β} : swap p = swap q ↔ p = q := swap_injective.eq_iff

lemma eq_iff_fst_eq_snd_eq : ∀{p q : α × β}, p = q ↔ (p.1 = q.1 ∧ p.2 = q.2)
| ⟨p₁, p₂⟩ ⟨q₁, q₂⟩ := by simp

lemma fst_eq_iff : ∀ {p : α × β} {x : α}, p.1 = x ↔ p = (x, p.2)
| ⟨a, b⟩ x := by simp

lemma snd_eq_iff : ∀ {p : α × β} {x : β}, p.2 = x ↔ p = (p.1, x)
| ⟨a, b⟩ x := by simp

theorem lex_def (r : α → α → Prop) (s : β → β → Prop)
  {p q : α × β} : prod.lex r s p q ↔ r p.1 q.1 ∨ p.1 = q.1 ∧ s p.2 q.2 :=
⟨λ h, by cases h; simp *,
 λ h, match p, q, h with
 | (a, b), (c, d), or.inl h := lex.left _ _ h
 | (a, b), (c, d), or.inr ⟨e, h⟩ :=
   by change a = c at e; subst e; exact lex.right _ h
 end⟩

instance lex.decidable [decidable_eq α]
  (r : α → α → Prop) (s : β → β → Prop) [decidable_rel r] [decidable_rel s] :
  decidable_rel (prod.lex r s) :=
λ p q, decidable_of_decidable_of_iff (by apply_instance) (lex_def r s).symm

end prod

open function

lemma function.injective.prod_map {f : α → γ} {g : β → δ} (hf : injective f) (hg : injective g) :
  injective (prod.map f g) :=
λ x y h, prod.ext (hf (prod.ext_iff.1 h).1) (hg $ (prod.ext_iff.1 h).2)

lemma function.surjective.prod_map {f : α → γ} {g : β → δ} (hf : surjective f) (hg : surjective g) :
  surjective (prod.map f g) :=
λ p, let ⟨x, hx⟩ := hf p.1 in let ⟨y, hy⟩ := hg p.2 in ⟨(x, y), prod.ext hx hy⟩


import .category
import for_mathlib.data_set_basic

open category_theory
local notation f ` ∘ `:80 g:80 := g ≫ f

universe u

namespace homotopy_theory.topological_spaces
namespace Top

local notation `Top` := Top.{u}

def incl {X : Top} (A : set X) : Top.mk_ob A ⟶ X :=
Top.mk_hom subtype.val

def embedding_incl {X : Top} (A : set X) : embedding (incl A) :=
embedding_subtype_coe

noncomputable def factor_through_embedding {W X Y : Top} {f : W ⟶ Y} {g : X ⟶ Y}
  (hf : set.range f ⊆ set.range g) (hg : embedding g) : W ⟶ X :=
Top.mk_hom (classical.some $ (factors_iff f g).mpr hf) $
  by rw [hg.continuous_iff, ←classical.some_spec ((factors_iff f g).mpr hf)]; exact f.2

@[simp] lemma factor_through_embedding_commutes {W X Y : Top} {f : W ⟶ Y} {g : X ⟶ Y}
  {hf : set.range f ⊆ set.range g} {hg : embedding g} : factor_through_embedding hf hg ≫ g = f :=
Top.hom_eq2.mpr $
(classical.some_spec ((factors_iff f g).mpr hf)).symm

def factor_through_incl {W X : Top} (f : W ⟶ X) (A : set X) (h : set.range f ⊆ A) :
  W ⟶ Top.mk_ob A :=
Top.mk_hom (λ (w : W), ⟨f w, h (set.mem_range_self w)⟩) (by continuity)

@[simp] lemma factor_through_incl_commutes {W X : Top} (f : W ⟶ X) (A : set X) (h : set.range f ⊆ A) :
  incl A ∘ factor_through_incl f A h = f :=
by ext; refl

lemma embedding_of_embedding_comp {X Y Z : Top} {f : X ⟶ Y} (g : Y ⟶ Z)
  (hgf : embedding (g ∘ f)) : embedding f :=
embedding_of_embedding_compose f.2 g.2 hgf

def incl' {X : Top} (A B : set X) (h : A ⊆ B) : Top.mk_ob A ⟶ Top.mk_ob B :=
Top.mk_hom (λ a, ⟨a.val, h a.property⟩) (by continuity!)

end «Top»
end homotopy_theory.topological_spaces