(** This file is part of CoqEAL, the Coq Effective Algebra Library.
(c) Copyright INRIA and University of Gothenburg, see LICENSE *)
From mathcomp Require Import ssreflect ssrfun ssrbool eqtype ssrnat div seq path ssralg.
From mathcomp Require Import fintype perm choice finfun matrix bigop zmodp poly mxpoly.
Unset SsrOldRewriteGoalsOrder.  (* remove the line when requiring MathComp >= 2.6 *)

Import GRing.Theory.

Set Implicit Arguments.
Unset Strict Implicit.
Unset Printing Implicit Defensive.

Open Scope ring_scope.

Section submatrix_def.

Variable A B : Type.

Definition submatrix T m n p q (f : 'I_p -> 'I_m) (g : 'I_q -> 'I_n)
  (M : 'M[T]_(m,n)) := \matrix_(i < p, j < q) M (f i) (g j).

Lemma sub_submatrix k k' l l' m n (M : 'M[A]_(m,n)) (f' : 'I_k -> 'I_m)
 (f : 'I_k' -> 'I_k) (g' : 'I_l -> 'I_n) (g : 'I_l' -> 'I_l) :
  submatrix f g (submatrix f' g' M) = submatrix (f' \o f) (g' \o g) M.
Proof. by rewrite /submatrix; apply/matrixP=> i j; rewrite !mxE. Qed.

Lemma submatrix_map_mx (f : A -> B) m n p k (M : 'M[A]_(m,n))
  (g : 'I_p -> 'I_m) (h : 'I_k -> 'I_n) :
  submatrix g h (map_mx f M) = map_mx f (submatrix g h M).
Proof. by rewrite /submatrix; apply/matrixP=> i j; rewrite !mxE. Qed.

End submatrix_def.

Section lifting.

Lemma widen_ord_eq (m n : nat) (h h' : n <= m) : widen_ord h =1 widen_ord h'.
Proof. by move=> x; apply/ord_inj. Qed.

(* transform [a .. b] into [0, a+1, .., b+1] *)
Definition lift_pred m n (f : 'I_n -> 'I_m) : 'I_n.+1 -> 'I_m.+1 :=
  fun (x : 'I_(1 + n)) =>
    if split x is inr j then lift 0 (f j) else 0.

Lemma size_tool n k : k <= n -> k < n.+1.
Proof. by rewrite ltnS. Qed.

(* lift step [ 0.. n-1] = [0 .. n ] *)
Lemma lift_pred_widen_ord m n (h : n <= m) :
  lift_pred (widen_ord h) =1 widen_ord (size_tool h).
Proof.
rewrite /lift_pred => x; have [y hx|y hx] := splitP; apply/ord_inj => //=.
by rewrite hx [y]ord1.
Qed.

Lemma lift_pred0 n k (f: 'I_k -> 'I_n) : lift_pred f 0 = 0.
Proof. by rewrite /lift_pred; case: splitP. Qed.

Lemma lift_predS n k (f : 'I_k -> 'I_n) (x : 'I_k) :
  lift_pred f (lift 0 x) = lift 0 (f x).
Proof. by rewrite /lift_pred split1 liftK. Qed.

(* Lemma step0 n (h : 1 <= n.+1) (x : 'I_1) : widen_ord h x = 0. *)
(* Proof. by rewrite [x]ord1; apply/ord_inj. Qed. *)

(* Lemma stepn n (h : n <= n) (x : 'I_n) : widen_ord h x = x. *)
(* Proof. by apply/ord_inj. Qed. *)

Lemma inj_lift m n (f : 'I_n -> 'I_m) : injective f -> injective (lift_pred f).
Proof.
rewrite /lift_pred => hf x y; rewrite !split1.
have [/= j ->|->] := unliftP; last by have [|-> //] := unliftP.
by have [/= i -> /lift_inj/hf ->|] := unliftP.
Qed.

Lemma inj_widen_ord n m (h : n <= m) : injective (widen_ord h).
Proof.
move => x y hxy.
have /= {}hxy : widen_ord h x = widen_ord h y :> nat by rewrite hxy.
by apply/ord_inj.
Qed.

End lifting.

Section submatrix_theory.

Variable R : pzRingType.

Lemma submatrix_eq m n p q (f1 g1 : 'I_p -> 'I_m) (f2 g2 : 'I_q -> 'I_n)
  (M : 'M[R]_(m,n)) (h1 : f1 =1 g1) (h2 : f2 =1 g2) :
  submatrix f1 f2 M = submatrix g1 g2 M.
Proof. by apply/matrixP => i j; rewrite !mxE (h1 i) (h2 j). Qed.

Lemma submatrix_lift_block m n p q (f1 : 'I_p -> 'I_m) (f2 : 'I_q -> 'I_n)
  a (M: 'M[R]_(m,n)) (c : 'cV[R]_m) (l : 'rV[R]_n) :
  submatrix (lift_pred f1) (lift_pred f2) (block_mx a%:M l c M) =
  block_mx a%:M (submatrix id f2 l) (submatrix f1 id c) (submatrix f1 f2 M).
Proof.
apply/matrixP => i j; rewrite !mxE /lift_pred !split1.
case: (oapp _ _ (unlift 0 i)) => x.
  rewrite unlift_none /= [x]ord1 !mxE !split1.
  case: (oapp _ _ (unlift 0 j)) => y; first by rewrite unlift_none [y]ord1.
  by rewrite liftK mxE.
rewrite liftK /= !mxE !split1.
case: (oapp _ _ (unlift 0 j)) => y; first by rewrite unlift_none mxE [y]ord1.
by rewrite liftK mxE.
Qed.

Lemma submatrix0 n m p q (f1 : 'I_p -> 'I_m) (f2 : 'I_q -> 'I_n) :
  submatrix f1 f2 0 = 0 :> 'M[R]__.
Proof. by apply/matrixP => i j; rewrite !mxE. Qed.

Lemma submatrix_scale m n p k (A : 'M[R]_(m,n))
  (f : 'I_p -> 'I_m) (g : 'I_k -> 'I_n) a :
  submatrix f g (a *: A) = a *: submatrix f g A.
Proof. by apply/matrixP => i j; rewrite !mxE. Qed.

Lemma submatrix_add m n p k (A B : 'M[R]_(m,n))
  (f : 'I_p -> 'I_m) (g : 'I_k -> 'I_n) :
  submatrix f g (A + B) = submatrix f g A + submatrix f g B.
Proof. by apply/matrixP => i j; rewrite !mxE. Qed.

Lemma submatrix_opp m n p k (A : 'M[R]_(m,n))
  (f : 'I_p -> 'I_m) (g : 'I_k -> 'I_n) :
  submatrix f g (- A) = - submatrix f g A.
Proof. by apply/matrixP => i j; rewrite !mxE. Qed.

Lemma submatrix_sub m n p k (A B : 'M[R]_(m,n))
  (f : 'I_p -> 'I_m) (g : 'I_k -> 'I_n) :
  submatrix f g (A - B) = submatrix f g A - submatrix f g B.
Proof. by apply/matrixP => i j; rewrite !mxE. Qed.

Lemma submatrix_mul m n p k l (A : 'M[R]_(m,n)) (B : 'M[R]_(n,p))
  (f : 'I_k -> 'I_m) (g : 'I_l -> 'I_p):
  submatrix f g (A *m B) = (submatrix f id A) *m (submatrix id g B).
Proof.
apply/matrixP => i j; rewrite !mxE.
by apply/eq_big => // x _; rewrite !mxE.
Qed.

Lemma submatrix_scalar_mx m p (f : 'I_p -> 'I_m) (hf : injective f) (a : R) :
  submatrix f f a%:M = a%:M.
Proof.
apply/matrixP => i j; rewrite !mxE.
case h : (f i == f j); first by rewrite (hf _ _ (eqP h)) eqxx.
by case h': (i == j) => //; move: h; rewrite (eqP h') eqxx.
Qed.

End submatrix_theory.

(* This must be put in a new section as it uses the theory on submatrix *)
Section submatrix_char_poly_mx.

Variable R : nzRingType.

Lemma submatrix_char_poly_mx m p (M : 'M[R]_m)
  (f : 'I_p -> 'I_m) (hf : injective f) :
  submatrix f f (char_poly_mx M) = char_poly_mx (submatrix f f M).
Proof.
by rewrite /char_poly_mx -submatrix_map_mx submatrix_sub submatrix_scalar_mx.
Qed.

End submatrix_char_poly_mx.

(* Minors *)
Section minor_def.

Variable R : pzRingType.

Definition minor (m n p : nat) (f : 'I_p -> 'I_m) (g : 'I_p -> 'I_n)
  (A : 'M[R]_(m,n)) := \det (submatrix f g A).

(* Principal minor *)
Definition pminor (m n p : nat) (h : p < m) (h' : p < n) (A : 'M[R]_(m,n)) :=
  minor (widen_ord h) (widen_ord h') A.

End minor_def.

Arguments minor {R m n p} f g A.

Section minor_theory.

Variable R : comPzRingType.

Lemma minor1 m n (A : 'M[R]_(m,n)) i j :
  minor (fun (_ : 'I_1) => i) (fun _ => j) A = A i j.
Proof. by rewrite /minor [submatrix _ _ _]mx11_scalar det_scalar1 !mxE. Qed.

Lemma minorn n (A : 'M[R]_n) : minor id id A = \det A.
Proof.
by rewrite /minor /submatrix; congr (\det _); apply/matrixP=> i j; rewrite mxE.
Qed.

Lemma det2 (A : 'M[R]_(2,2)) : \det A = A 0 0 * A 1 1 - A 1 0 * A 0 1.
Proof.
rewrite (expand_det_col _ 0) !big_ord_recl big_ord0 addr0 /cofactor /=.
rewrite ?(addn0,expr0,mul1r) /bump leq0n /= addn0 expr1.
do 2! rewrite [X in \det X]mx11_scalar det_scalar1 /=.
by rewrite !mxE !mulNr mul1r mulrN; do ?f_equal; apply/ord_inj.
Qed.

(* Sanity check of the definiton *)
Lemma minor2 m n (A : 'M[R]_(m,n)) (f : 'I_2 -> 'I_m) (g : 'I_2 -> 'I_n) :
  minor f g A = A (f 0) (g 0) * A (f 1) (g 1) - A (f 1) (g 0) * A (f 0) (g 1).
Proof. by rewrite /minor det2 !mxE. Qed.

Lemma minor_ltn_eq0l k m1 m2 n1 n2 x (f : 'I_k -> 'I_(m1 + m2)) g
  (M : 'M[R]_(m1,n1)) (N : 'M_(m1,n2)) (H : m1 < f x) :
  minor f g (block_mx M N 0 0) = 0.
Proof.
rewrite /minor (expand_det_row _ x) big1 // => i _; rewrite !mxE.
case: splitP H => [j ->|j Hj]; first by rewrite ltnNge ltnW.
by rewrite row_mx0 mxE mul0r.
Qed.

Lemma minor_ltn_eq0r k m1 m2 n1 n2 x f (g : 'I_k -> 'I_(n1 + n2))
  (M : 'M[R]_(m1,n1)) (N : 'M_(m2,n1)) (H : n1 < g x) :
  minor f g (block_mx M 0 N 0) = 0.
Proof.
rewrite /minor (expand_det_col _ x) big1 // => i _; rewrite !mxE.
by case: splitP=> j Hj; rewrite mxE; case: splitP H=> [l ->|l];
  rewrite ?ltnNge ?mxE ?mul0r // ltnW.
Qed.

Lemma minor_alternate_f m n p (f : 'I_p -> 'I_m) g (M : 'M[R]_(m,n)) :
  (exists x y, (x != y) /\ (f x == f y)) -> minor f g M = 0.
Proof.
rewrite /minor => [[x [y [hxy /eqP hf]]]].
by rewrite (determinant_alternate hxy) // => a; rewrite !mxE hf.
Qed.

Lemma minor_alternate_g m n p (f : 'I_p -> 'I_m) g (M : 'M[R]_(m,n)) :
  (exists x y, (x != y) /\ (g x == g y)) -> minor f g M = 0.
Proof.
rewrite /minor => [[x [y [hxy /eqP hg]]]].
by rewrite -det_tr (determinant_alternate hxy) // => a /=; rewrite !mxE hg.
Qed.

Lemma minor_f_not_injective m n p (f : 'I_p -> 'I_m) g (M: 'M[R]_(m,n)) :
  ~ injective f -> minor f g M = 0.
Proof.
move/injectiveP/injectivePn => [x [y hxy hf]]; apply minor_alternate_f.
by exists x, y; rewrite hf.
Qed.

Lemma minor_g_not_injective m n p (f : 'I_p -> 'I_m) g (M: 'M[R]_(m,n)) :
  ~ injective g -> minor f g M = 0.
Proof.
move/injectiveP/injectivePn => [x [y hxy hg]]; apply minor_alternate_g.
by exists x, y; rewrite hg.
Qed.

Lemma minor_eq m n p (f1 g1 : 'I_p -> 'I_m) (f2 g2 : 'I_p -> 'I_n)
  (h1 : f1 =1 g1) (h2 : f2 =1 g2) (M : 'M[R]_(m,n)) :
  minor f1 f2 M = minor g1 g2 M.
Proof. by rewrite /minor (submatrix_eq M h1 h2). Qed.

Lemma minor_lift_block m n p (f1 : 'I_p -> 'I_m) (f2 : 'I_p -> 'I_n)
  a (M : 'M[R]_(m,n)) (l : 'rV[R]_n) :
  minor (lift_pred f1) (lift_pred f2) (block_mx a%:M l 0 M) = a * minor f1 f2 M.
Proof.
by rewrite /minor submatrix_lift_block submatrix0 (@det_ublock _ 1) det_scalar1.
Qed.

End minor_theory.

Section minor_char_poly_mx.

Variable R : comNzRingType.

(* all principal minor of the characteristic matrix are monic *)
Lemma pminor_char_poly_mx_monic m p (M : 'M[R]_m) (h h': p.+1 <= m) :
  pminor h h' (char_poly_mx M) \is monic.
Proof.
have h'h : widen_ord h' =1 widen_ord h by apply/widen_ord_eq.
rewrite /pminor (minor_eq (frefl _) h'h) /minor submatrix_char_poly_mx.
  exact: inj_widen_ord.
by rewrite char_poly_monic.
Qed.

End minor_char_poly_mx.
