(* (c) Copyright 2006-2016 Microsoft Corporation and Inria.                  *)
(* Distributed under the terms of CeCILL-B.                                  *)
From mathcomp
From mathcomp
From mathcomp
(*****************************************************************************)
(* In this file we develop the rank and row space theory of matrices, based  *)
(* on an extended Gaussian elimination procedure similar to LUP              *)
(* decomposition. This provides us with a concrete but generic model of      *)
(* finite dimensional vector spaces and F-algebras, in which vectors, linear *)
(* functions, families, bases, subspaces, ideals and subrings are all        *)
(* represented using matrices. This model can be used as a foundation for    *)
(* the usual theory of abstract linear algebra, but it can also be used to   *)
(* develop directly substantial theories, such as the theory of finite group *)
(* linear representation.                                                    *)
(*   Here we define the following concepts and notations:                    *)
(* Gaussian_elimination A == a permuted triangular decomposition (L, U, r)   *)
(*                   of A, with L a column permutation of a lower triangular *)
(*                   invertible matrix, U a row permutation of an upper      *)
(*                   triangular invertible matrix, and r the rank of A, all  *)
(*                   satisfying the identity L *m pid_mx r *m U = A.         *)
(*        \rank A == the rank of A.                                          *)
(*    row_free A <=> the rows of A are linearly free (i.e., the rank and     *)
(*                   height of A are equal).                                 *)
(*    row_full A <=> the row-space of A spans all row-vectors (i.e., the     *)
(*                   rank and width of A are equal).                         *)
(*    col_ebase A == the extended column basis of A (the first matrix L      *)
(*                   returned by Gaussian_elimination A).                    *)
(*    row_ebase A == the extended row base of A (the second matrix U         *)
(*                   returned by Gaussian_elimination A).                    *)
(*     col_base A == a basis for the columns of A: a row-full matrix         *)
(*                   consisting of the first \rank A columns of col_ebase A. *)
(*     row_base A == a basis for the rows of A: a row-free matrix consisting *)
(*                   of the first \rank A rows of row_ebase A.               *)
(*       pinvmx A == a partial inverse for A in its row space (or on its     *)
(*                   column space, equivalently). In particular, if u is a   *)
(*                   row vector in the row_space of A, then u *m pinvmx A is *)
(*                   the row vector of the coefficients of a decomposition   *)
(*                   of u as a sub of rows of A.                             *)
(*        kermx A == the row kernel of A : a square matrix whose row space   *)
(*                   consists of all u such that u *m A = 0 (it consists of  *)
(*                   the inverse of col_ebase A, with the top \rank A rows   *)
(*                   zeroed out). Also, kermx A is a partial right inverse   *)
(*                   to col_ebase A, in the row space anihilated by A.       *)
(*      cokermx A == the cokernel of A : a square matrix whose column space  *)
(*                   consists of all v such that A *m v = 0 (it consists of  *)
(*                   the inverse of row_ebase A, with the leftmost \rank A   *)
(*                   columns zeroed out).                                    *)
(* eigenvalue g a <=> a is an eigenvalue of the square matrix g.             *)
(* eigenspace g a == a square matrix whose row space is the eigenspace of    *)
(*                   the eigenvalue a of g (or 0 if a is not an eigenvalue). *)
(* We use a different scope %MS for matrix row-space set-like operations; to *)
(* avoid confusion, this scope should not be opened globally. Note that the  *)
(* the arguments of \rank _ and the operations below have default scope %MS. *)
(*    (A <= B)%MS <=> the row-space of A is included in the row-space of B.  *)
(*                   We test for this by testing if cokermx B anihilates A.  *)
(*     (A < B)%MS <=> the row-space of A is properly included in the         *)
(*                   row-space of B.                                         *)
(*  (A <= B <= C)%MS == (A <= B)%MS && (B <= C)%MS, and similarly for        *)
(*                   (A < B <= C)%MS, (A < B <= C)%MS and (A < B < C)%MS.    *)
(*    (A == B)%MS == (A <= B <= A)%MS (A and B have the same row-space).     *)
(*   (A :=: B)%MS == A and B behave identically wrt. \rank and <=. This      *)
(*                   triple rewrite rule is the Prop version of (A == B)%MS. *)
(*                   Note that :=: cannot be treated as a setoid-style       *)
(*                   Equivalence because its arguments can have different    *)
(*                   types: A and B need not have the same number of rows,   *)
(*                   and often don't (e.g., in row_base A :=: A).            *)
(*       <<A>>%MS == a square matrix with the same row-space as A; <<A>>%MS  *)
(*                   is a canonical representation of the subspace generated *)
(*                   by A, viewed as a list of row-vectors: if (A == B)%MS,  *)
(*                   then <<A>>%MS = <<B>>%MS.                               *)
(*     (A + B)%MS == a square matrix whose row-space is the sum of the       *)
(*                   row-spaces of A and B; thus (A + B == col_mx A B)%MS.   *)
(*  (\sum_i <expr i>)%MS == the "big" version of (_ + _)%MS; as the latter   *)
(*                   has a canonical abelian monoid structure, most generic  *)
(*                   bigop lemmas apply (the other bigop indexing notations  *)
(*                   are also defined).                                      *)
(*   (A :&: B)%MS == a square matrix whose row-space is the intersection of  *)
(*                   the row-spaces of A and B.                              *)
(*  (\bigcap_i <expr i>)%MS == the "big" version of (_ :&: _)%MS, which also *)
(*                   has a canonical abelian monoid structure.               *)
(*         A^C%MS == a square matrix whose row-space is a complement to the  *)
(*                   the row-space of A (it consists of row_ebase A with the *)
(*                   top \rank A rows zeroed out).                           *)
(*   (A :\: B)%MS == a square matrix whose row-space is a complement of the  *)
(*                   the row-space of (A :&: B)%MS in the row-space of A.    *)
(*                   We have (A :\: B := A :&: (capmx_gen A B)^C)%MS, where  *)
(*                   capmx_gen A B is a rectangular matrix equivalent to     *)
(*                   (A :&: B)%MS, i.e., (capmx_gen A B == A :&: B)%MS.      *)
(*    proj_mx A B == a square matrix that projects (A + B)%MS onto A         *)
(*                   parallel to B, when (A :&: B)%MS = 0 (A and B must also *)
(*                   be square).                                             *)
(*     mxdirect S == the sum expression S is a direct sum. This is a NON     *)
(*                   EXTENSIONAL notation: the exact boolean expression is   *)
(*                   inferred from the syntactic form of S (expanding        *)
(*                   definitions, however); both (\sum_(i | _) _)%MS and     *)
(*                   (_ + _)%MS sums are recognized. This construct uses a   *)
(*                   variant of the reflexive ("quote") canonical structure, *)
(*                   mxsum_expr. The structure also recognizes sums of       *)
(*                   matrix ranks, so that lemmas concerning the rank of     *)
(*                   direct sums can be used bidirectionally.                *)
(* The next set of definitions let us represent F-algebras using matrices:   *)
(*   'A[F]_(m, n) == the type of matrices encoding (sub)algebras of square   *)
(*                   n x n matrices, via mxvec; as in the matrix type        *)
(*                   notation, m and F can be omitted (m defaults to n ^ 2). *)
(*                := 'M[F]_(m, n ^ 2).                                       *)
(*   (A \in R)%MS <=> the square matrix A belongs to the linear set of       *)
(*                    matrices (most often, a sub-algebra) encoded by the    *)
(*                    row space of R. This is simply notation, so all the    *)
(*                    lemmas and rewrite rules for (_ <= _)%MS can apply.    *)
(*                := (mxvec A <= R)%MS.                                      *)
(*     (R * S)%MS == a square n^2 x n^2 matrix whose row-space encodes the   *)
(*                   linear set of n x n matrices generated by the pointwise *)
(*                   product of the sets of matrices encoded by R and S.     *)
(*       'C(R)%MS == a square matric encoding the centraliser of the set of  *)
(*                   square matrices encoded by R.                           *)
(*     'C_S(R)%MS := (S :&: 'C(R))%MS (the centraliser of R in S).           *)
(*       'Z(R)%MS == the center of R (i.e., 'C_R(R)%MS).                     *)
(*  left_mx_ideal R S <=> S is a left ideal for R (R * S <= S)%MS.           *)
(* right_mx_ideal R S <=> S is a right ideal for R (S * R <= S)%MS.          *)
(*       mx_ideal R S <=> S is a bilateral ideal for R.                      *)
(*      mxring_id R e <-> e is an identity element for R (Prop predicate).   *)
(*    has_mxring_id R <=> R has a nonzero identity element (bool predicate). *)
(*           mxring R <=> R encodes a nontrivial subring.                    *)
(*****************************************************************************)
Set Implicit Arguments.
Unset Strict Implicit.
Unset Printing Implicit Defensive.
Local Open Scope ring_scope.
Reserved Notation "\rank A" (at level 10, A at level 8, format "\rank  A").
Reserved Notation "A ^C"    (at level 8, format "A ^C").
Notation "''A_' ( m , n )" := 'M_(m, n ^ 2)
(at level 8, format "''A_' ( m ,  n )") : type_scope.
Notation "''A_' ( n )" := 'A_(n ^ 2, n)
(at level 8, only parsing) : type_scope.
Notation "''A_' n" := 'A_(n)
(at level 8, n at next level, format "''A_' n") : type_scope.
Notation "''A' [ F ]_ ( m , n )" := 'M[F]_(m, n ^ 2)
(at level 8, only parsing) : type_scope.
Notation "''A' [ F ]_ ( n )" := 'A[F]_(n ^ 2, n)
(at level 8, only parsing) : type_scope.
Notation "''A' [ F ]_ n" := 'A[F]_(n)
(at level 8, n at level 2, only parsing) : type_scope.
Delimit Scope matrix_set_scope with MS.
Local Notation simp := (Monoid.Theory.simpm, oppr0).
(*****************************************************************************)
(******************** Rank and row-space theory ******************************)
(*****************************************************************************)
Section RowSpaceTheory.
Variable F : fieldType.
Implicit Types m n p r : nat.
Local Notation "''M_' ( m , n )" := 'M[F]_(m, n) : type_scope.
Local Notation "''M_' n" := 'M[F]_(n, n) : type_scope.
(* Decomposition with double pivoting; computes the rank, row and column  *)
(* images, kernels, and complements of a matrix.                          *)
Fixpoint Gaussian_elimination {m n} : 'M_(m, n) -> 'M_m * 'M_n * nat :=
match m, n with
| _.+1, _.+1 => fun A : 'M_(1 + _, 1 + _) =>
if [pick ij | A ij.1 ij.2 != 0] is Some (i, j) then
let a := A i j in let A1 := xrow i 0 (xcol j 0 A) in
let u := ursubmx A1 in let v := a^-1 *: dlsubmx A1 in
let: (L, U, r) := Gaussian_elimination (drsubmx A1 - v *m u) in
(xrow i 0 (block_mx 1 0 v L), xcol j 0 (block_mx a%:M u 0 U), r.+1)
else (1%:M, 1%:M, 0%N)
| _, _ => fun _ => (1%:M, 1%:M, 0%N)
end.
Section Defs.
Variables (m n : nat) (A : 'M_(m, n)).
Fact Gaussian_elimination_key : unit. Proof. by []. Qed.
Let LUr := locked_with Gaussian_elimination_key (@Gaussian_elimination) m n A.
Definition col_ebase := LUr.1.1.
Definition row_ebase := LUr.1.2.
Definition mxrank := if [|| m == 0 | n == 0]%N then 0%N else LUr.2.
Definition row_free := mxrank == m.
Definition row_full := mxrank == n.
Definition row_base : 'M_(mxrank, n) := pid_mx mxrank *m row_ebase.
Definition col_base : 'M_(m, mxrank) := col_ebase *m pid_mx mxrank.
Definition complmx : 'M_n := copid_mx mxrank *m row_ebase.
Definition kermx : 'M_m := copid_mx mxrank *m invmx col_ebase.
Definition cokermx : 'M_n := invmx row_ebase *m copid_mx mxrank.
Definition pinvmx : 'M_(n, m) :=
invmx row_ebase *m pid_mx mxrank *m invmx col_ebase.
End Defs.
Arguments mxrank {m%N n%N} A%MS.
Local Notation "\rank A" := (mxrank A) : nat_scope.
Arguments complmx {m%N n%N} A%MS.
Local Notation "A ^C" := (complmx A) : matrix_set_scope.
Definition submx_def := idfun (fun m1 m2 n (A : 'M_(m1, n)) (B : 'M_(m2, n)) =>
A *m cokermx B == 0).
Fact submx_key : unit. Proof. by []. Qed.
Definition submx := locked_with submx_key submx_def.
Canonical submx_unlockable := [unlockable fun submx].
Arguments submx {m1%N m2%N n%N} A%MS B%MS : rename.
Local Notation "A <= B" := (submx A B) : matrix_set_scope.
Local Notation "A <= B <= C" := ((A <= B) && (B <= C))%MS : matrix_set_scope.
Local Notation "A == B" := (A <= B <= A)%MS : matrix_set_scope.
Definition ltmx m1 m2 n (A : 'M_(m1, n)) (B : 'M_(m2, n)) :=
(A <= B)%MS && ~~ (B <= A)%MS.
Arguments ltmx {m1%N m2%N n%N} A%MS B%MS.
Local Notation "A < B" := (ltmx A B) : matrix_set_scope.
Definition eqmx m1 m2 n (A : 'M_(m1, n)) (B : 'M_(m2, n)) :=
prod (\rank A = \rank B)
(forall m3 (C : 'M_(m3, n)),
((A <= C) = (B <= C)) * ((C <= A) = (C <= B)))%MS.
Arguments eqmx {m1%N m2%N n%N} A%MS B%MS.
Local Notation "A :=: B" := (eqmx A B) : matrix_set_scope.
Section LtmxIdentities.
Variables (m1 m2 n : nat) (A : 'M_(m1, n)) (B : 'M_(m2, n)).

(* Specifications: *)
Lemma ltmxE : (A < B)%MS = ((A <= B)%MS && ~~ (B <= A)%MS). Proof. by []. Qed.
Lemma ltmxW : (A < B)%MS -> (A <= B)%MS. Proof. by case/andP. Qed.
Lemma ltmxEneq : (A < B)%MS = (A <= B)%MS && ~~ (A == B)%MS.
Lemma row_leq_rank m n (A : 'M_(m, n)) : (m <= \rank A) = row_free A.
Lemma col_leq_rank m n (A : 'M_(m, n)) : (n <= \rank A) = row_full A.
Lemma col_ebase_unit m n (A : 'M_(m, n)) : col_ebase A \in unitmx.
Hint Resolve rank_leq_row rank_leq_col row_ebase_unit col_ebase_unit : core.
Lemma mulmx_ebase m n (A : 'M_(m, n)) :
col_ebase A *m pid_mx (\rank A) *m row_ebase A = A.
Lemma mulmx_base m n (A : 'M_(m, n)) : col_base A *m row_base A = A.
Arguments mulmx_max_rank [r m n].
Lemma mxrank_tr m n (A : 'M_(m, n)) : \rank A^T = \rank A.
Lemma mxrank_add m n (A B : 'M_(m, n)) : \rank (A + B)%R <= \rank A + \rank B.
Lemma mxrankM_maxl m n p (A : 'M_(m, n)) (B : 'M_(n, p)) :
\rank (A *m B) <= \rank A.
Lemma mxrank_opp m n (A : 'M_(m, n)) : \rank (- A) = \rank A.
Lemma mulmx_coker m n (A : 'M_(m, n)) : A *m cokermx A = 0.
Lemma submxE m1 m2 n (A : 'M_(m1, n)) (B : 'M_(m2, n)) :
(A <= B)%MS = (A *m cokermx B == 0).
Lemma submxP m1 m2 n (A : 'M_(m1, n)) (B : 'M_(m2, n)) :
reflect (exists D, A = D *m B) (A <= B)%MS.