(* (c) Copyright 2006-2016 Microsoft Corporation and Inria.                  *)
(* Distributed under the terms of CeCILL-B.                                  *)
From mathcomp
From mathcomp
From mathcomp
(******************************************************************************)
(* Basic concrete linear algebra : definition of type for matrices, and all   *)
(* basic matrix operations including determinant, trace and support for block *)
(* decomposition. Matrices are represented by a row-major list of their       *)
(* coefficients but this implementation is hidden by three levels of wrappers *)
(* (Matrix/Finfun/Tuple) so the matrix type should be treated as abstract and *)
(* handled using only the operations described below:                         *)
(*   'M[R]_(m, n) == the type of m rows by n columns matrices with            *)
(*   'M_(m, n)       coefficients in R; the [R] is optional and is usually    *)
(*                   omitted.                                                 *)
(*  'M[R]_n, 'M_n == the type of n x n square matrices.                       *)
(* 'rV[R]_n, 'rV_n == the type of 1 x n row vectors.                          *)
(* 'cV[R]_n, 'cV_n == the type of n x 1 column vectors.                       *)
(*  \matrix_(i < m, j < n) Expr(i, j) ==                                      *)
(*                   the m x n matrix with general coefficient Expr(i, j),    *)
(*                   with i : 'I_m and j : 'I_n. the < m bound can be omitted *)
(*                   if it is equal to n, though usually both bounds are      *)
(*                   omitted as they can be inferred from the context.        *)
(*  \row_(j < n) Expr(j), \col_(i < m) Expr(i)                                *)
(*                   the row / column vectors with general term Expr; the     *)
(*                   parentheses can be omitted along with the bound.         *)
(* \matrix_(i < m) RowExpr(i) ==                                              *)
(*                   the m x n matrix with row i given by RowExpr(i) : 'rV_n. *)
(*          A i j == the coefficient of matrix A : 'M_(m, n) in column j of   *)
(*                   row i, where i : 'I_m, and j : 'I_n (via the coercion    *)
(*                   fun_of_matrix : matrix >-> Funclass).                    *)
(*     const_mx a == the constant matrix whose entries are all a (dimensions  *)
(*                   should be determined by context).                        *)
(*     map_mx f A == the pointwise image of A by f, i.e., the matrix Af       *)
(*                   congruent to A with Af i j = f (A i j) for all i and j.  *)
(*            A^T == the matrix transpose of A.                               *)
(*        row i A == the i'th row of A (this is a row vector).                *)
(*        col j A == the j'th column of A (a column vector).                  *)
(*       row' i A == A with the i'th row spliced out.                         *)
(*       col' i A == A with the j'th column spliced out.                      *)
(*   xrow i1 i2 A == A with rows i1 and i2 interchanged.                      *)
(*   xcol j1 j2 A == A with columns j1 and j2 interchanged.                   *)
(*   row_perm s A == A : 'M_(m, n) with rows permuted by s : 'S_m.            *)
(*   col_perm s A == A : 'M_(m, n) with columns permuted by s : 'S_n.         *)
(*   row_mx Al Ar == the row block matrix <Al Ar> obtained by contatenating   *)
(*                   two matrices Al and Ar of the same height.               *)
(*   col_mx Au Ad == the column block matrix / Au \ (Au and Ad must have the  *)
(*                   same width).            \ Ad /                           *)
(* block_mx Aul Aur Adl Adr == the block matrix / Aul Aur \                   *)
(*                                              \ Adl Adr /                   *)
(*   [l|r]submx A == the left/right submatrices of a row block matrix A.      *)
(*                   Note that the type of A, 'M_(m, n1 + n2) indicates how A *)
(*                   should be decomposed.                                    *)
(*   [u|d]submx A == the up/down submatrices of a column block matrix A.      *)
(* [u|d][l|r]submx A == the upper left, etc submatrices of a block matrix A.  *)
(* castmx eq_mn A == A : 'M_(m, n) cast to 'M_(m', n') using the equation     *)
(*                   pair eq_mn : (m = m') * (n = n'). This is the usual      *)
(*                   workaround for the syntactic limitations of dependent    *)
(*                   types in Coq, and can be used to introduce a block       *)
(*                   decomposition. It simplifies to A when eq_mn is the      *)
(*                   pair (erefl m, erefl n) (using rewrite /castmx /=).      *)
(* conform_mx B A == A if A and B have the same dimensions, else B.           *)
(*        mxvec A == a row vector of width m * n holding all the entries of   *)
(*                   the m x n matrix A.                                      *)
(* mxvec_index i j == the index of A i j in mxvec A.                          *)
(*       vec_mx v == the inverse of mxvec, reshaping a vector of width m * n  *)
(*                   back into into an m x n rectangular matrix.              *)
(* In 'M[R]_(m, n), R can be any type, but 'M[R]_(m, n) inherits the eqType,  *)
(* choiceType, countType, finType, zmodType structures of R; 'M[R]_(m, n)     *)
(* also has a natural lmodType R structure when R has a ringType structure.   *)
(* Because the type of matrices specifies their dimension, only non-trivial   *)
(* square matrices (of type 'M[R]_n.+1) can inherit the ring structure of R;  *)
(* indeed they then have an algebra structure (lalgType R, or algType R if R  *)
(* is a comRingType, or even unitAlgType if R is a comUnitRingType).          *)
(*   We thus provide separate syntax for the general matrix multiplication,   *)
(* and other operations for matrices over a ringType R:                       *)
(*         A *m B == the matrix product of A and B; the width of A must be    *)
(*                   equal to the height of B.                                *)
(*           a%:M == the scalar matrix with a's on the main diagonal; in      *)
(*                   particular 1%:M denotes the identity matrix, and is is   *)
(*                   equal to 1%R when n is of the form n'.+1 (e.g., n >= 1). *)
(* is_scalar_mx A <=> A is a scalar matrix (A = a%:M for some A).             *)
(*      diag_mx d == the diagonal matrix whose main diagonal is d : 'rV_n.    *)
(*   delta_mx i j == the matrix with a 1 in row i, column j and 0 elsewhere.  *)
(*       pid_mx r == the partial identity matrix with 1s only on the r first  *)
(*                   coefficients of the main diagonal; the dimensions of     *)
(*                   pid_mx r are determined by the context, and pid_mx r can *)
(*                   be rectangular.                                          *)
(*     copid_mx r == the complement to 1%:M of pid_mx r: a square diagonal    *)
(*                   matrix with 1s on all but the first r coefficients on    *)
(*                   its main diagonal.                                       *)
(*      perm_mx s == the n x n permutation matrix for s : 'S_n.               *)
(* tperm_mx i1 i2 == the permutation matrix that exchanges i1 i2 : 'I_n.      *)
(*   is_perm_mx A == A is a permutation matrix.                               *)
(*     lift0_mx A == the 1 + n square matrix block_mx 1 0 0 A when A : 'M_n.  *)
(*          \tr A == the trace of a square matrix A.                          *)
(*         \det A == the determinant of A, using the Leibnitz formula.        *)
(* cofactor i j A == the i, j cofactor of A (the signed i, j minor of A),     *)
(*         \adj A == the adjugate matrix of A (\adj A i j = cofactor j i A).  *)
(*   A \in unitmx == A is invertible (R must be a comUnitRingType).           *)
(*        invmx A == the inverse matrix of A if A \in unitmx A, otherwise A.  *)
(* The following operations provide a correspondance between linear functions *)
(* and matrices:                                                              *)
(*     lin1_mx f == the m x n matrix that emulates via right product          *)
(*                  a (linear) function f : 'rV_m -> 'rV_n on ROW VECTORS     *)
(*      lin_mx f == the (m1 * n1) x (m2 * n2) matrix that emulates, via the   *)
(*                  right multiplication on the mxvec encodings, a linear     *)
(*                  function f : 'M_(m1, n1) -> 'M_(m2, n2)                   *)
(* lin_mul_row u := lin1_mx (mulmx u \o vec_mx) (applies a row-encoded        *)
(*                  function to the row-vector u).                            *)
(*       mulmx A == partially applied matrix multiplication (mulmx A B is     *)
(*                  displayed as A *m B), with, for A : 'M_(m, n), a          *)
(*                  canonical {linear 'M_(n, p) -> 'M(m, p}} structure.       *)
(*      mulmxr A == self-simplifying right-hand matrix multiplication, i.e.,  *)
(*                  mulmxr A B simplifies to B *m A, with, for A : 'M_(n, p), *)
(*                  a canonical {linear 'M_(m, n) -> 'M(m, p}} structure.     *)
(*   lin_mulmx A := lin_mx (mulmx A).                                         *)
(*  lin_mulmxr A := lin_mx (mulmxr A).                                        *)
(* We also extend any finType structure of R to 'M[R]_(m, n), and define:     *)
(*     {'GL_n[R]} == the finGroupType of units of 'M[R]_n.-1.+1.              *)
(*      'GL_n[R]  == the general linear group of all matrices in {'GL_n(R)}.  *)
(*      'GL_n(p)  == 'GL_n['F_p], the general linear group of a prime field.  *)
(*       GLval u  == the coercion of u : {'GL_n(R)} to a matrix.              *)
(*   In addition to the lemmas relevant to these definitions, this file also  *)
(* proves several classic results, including :                                *)
(* - The determinant is a multilinear alternate form.                         *)
(* - The Laplace determinant expansion formulas: expand_det_[row|col].        *)
(* - The Cramer rule : mul_mx_adj & mul_adj_mx.                               *)
(* Finally, as an example of the use of block products, we program and prove  *)
(* the correctness of a classical linear algebra algorithm:                   *)
(*    cormenLUP A == the triangular decomposition (L, U, P) of a nontrivial   *)
(*                   square matrix A into a lower triagular matrix L with 1s  *)
(*                   on the main diagonal, an upper matrix U, and a           *)
(*                   permutation matrix P, such that P * A = L * U.           *)
(* This is example only; we use a different, more precise algorithm to        *)
(* develop the theory of matrix ranks and row spaces in mxalgebra.v           *)
(******************************************************************************)
Set Implicit Arguments.
Unset Strict Implicit.
Unset Printing Implicit Defensive.
Local Open Scope ring_scope.
Reserved Notation "''M_' n"     (at level 8, n at level 2, format "''M_' n").
Reserved Notation "''rV_' n"    (at level 8, n at level 2, format "''rV_' n").
Reserved Notation "''cV_' n"    (at level 8, n at level 2, format "''cV_' n").
Reserved Notation "''M_' ( n )" (at level 8, only parsing).
Reserved Notation "''M_' ( m , n )" (at level 8, format "''M_' ( m ,  n )").
Reserved Notation "''M[' R ]_ n"    (at level 8, n at level 2, only parsing).
Reserved Notation "''rV[' R ]_ n"   (at level 8, n at level 2, only parsing).
Reserved Notation "''cV[' R ]_ n"   (at level 8, n at level 2, only parsing).
Reserved Notation "''M[' R ]_ ( n )"     (at level 8, only parsing).
Reserved Notation "''M[' R ]_ ( m , n )" (at level 8, only parsing).
Reserved Notation "\matrix_ i E"
(at level 36, E at level 36, i at level 2,
format "\matrix_ i  E").
Reserved Notation "\matrix_ ( i < n ) E"
(at level 36, E at level 36, i, n at level 50, only parsing).
Reserved Notation "\matrix_ ( i , j ) E"
(at level 36, E at level 36, i, j at level 50,
format "\matrix_ ( i ,  j )  E").
Reserved Notation "\matrix[ k ]_ ( i , j ) E"
(at level 36, E at level 36, i, j at level 50,
format "\matrix[ k ]_ ( i ,  j )  E").
Reserved Notation "\matrix_ ( i < m , j < n ) E"
(at level 36, E at level 36, i, m, j, n at level 50, only parsing).
Reserved Notation "\matrix_ ( i , j < n ) E"
(at level 36, E at level 36, i, j, n at level 50, only parsing).
Reserved Notation "\row_ j E"
(at level 36, E at level 36, j at level 2,
format "\row_ j  E").
Reserved Notation "\row_ ( j < n ) E"
(at level 36, E at level 36, j, n at level 50, only parsing).
Reserved Notation "\col_ j E"
(at level 36, E at level 36, j at level 2,
format "\col_ j  E").
Reserved Notation "\col_ ( j < n ) E"
(at level 36, E at level 36, j, n at level 50, only parsing).
Reserved Notation "x %:M"   (at level 8, format "x %:M").
Reserved Notation "A *m B" (at level 40, left associativity, format "A  *m  B").
Reserved Notation "A ^T"    (at level 8, format "A ^T").
Reserved Notation "\tr A"   (at level 10, A at level 8, format "\tr  A").
Reserved Notation "\det A"  (at level 10, A at level 8, format "\det  A").
Reserved Notation "\adj A"  (at level 10, A at level 8, format "\adj  A").
Local Notation simp := (Monoid.Theory.simpm, oppr0).
(*****************************************************************************)
(****************************Type Definition**********************************)
(*****************************************************************************)
Section MatrixDef.
Variable R : Type.
Variables m n : nat.
(* Basic linear algebra (matrices).                                       *)
(* We use dependent types (ordinals) for the indices so that ranges are   *)
(* mostly inferred automatically                                          *)
Inductive matrix : predArgType := Matrix of {ffun 'I_m * 'I_n -> R}.
Definition mx_val A := let: Matrix g := A in g.
Canonical matrix_subType := Eval hnf in [newType for mx_val].
Fact matrix_key : unit. Proof. by []. Qed.
Definition matrix_of_fun_def F := Matrix [ffun ij => F ij.1 ij.2].
Definition matrix_of_fun k := locked_with k matrix_of_fun_def.
Canonical matrix_unlockable k := [unlockable fun matrix_of_fun k].
Definition fun_of_matrix A (i : 'I_m) (j : 'I_n) := mx_val A (i, j).
Coercion fun_of_matrix : matrix >-> Funclass.

(* Specifications: *)
Lemma mxE k F : matrix_of_fun k F =2 F.
End MatrixDef.