void evaluateSPQRSolver(const Eigen::MatrixXd& A, const Eigen::VectorXd& b,
const Eigen::VectorXd& x) {
cholmod_common cholmod;
cholmod_l_start(&cholmod);
cholmod_sparse* A_CS = aslam::calibration::eigenDenseToCholmodSparseCopy(A,
&cholmod);
cholmod_dense b_CD;
aslam::calibration::eigenDenseToCholmodDenseView(b, &b_CD);
Eigen::VectorXd x_est;
// const double before = aslam::calibration::Timestamp::now();
SuiteSparseQR_factorization<double>* factor = SuiteSparseQR_factorize<double>(
SPQR_ORDERING_BEST, SPQR_DEFAULT_TOL, A_CS, &cholmod);
cholmod_dense* Qtb = SuiteSparseQR_qmult<double>(SPQR_QTX, factor, &b_CD,
&cholmod);
cholmod_dense* x_est_cd = SuiteSparseQR_solve<double>(SPQR_RETX_EQUALS_B,
factor, Qtb, &cholmod);
cholmod_l_free_dense(&Qtb, &cholmod);
aslam::calibration::cholmodDenseToEigenDenseCopy(x_est_cd, x_est);
cholmod_l_free_dense(&x_est_cd, &cholmod);
// std::cout << "estimated rank: " << factor->rank << std::endl;
// std::cout << "estimated rank deficiency: " << A.cols() - factor->rank
// << std::endl;
SuiteSparseQR_free(&factor, &cholmod);
// const double after = aslam::calibration::Timestamp::now();
// const double error = (b - A * x_est).norm();
// std::cout << std::fixed << std::setprecision(18) << "error: " << error
// << " est_diff: " << (x - x_est).norm() << " time: " << after - before
// << std::endl;
cholmod_l_free_sparse(&A_CS, &cholmod);
cholmod_l_finish(&cholmod);
}
int main (int argc, char **argv)
{
cholmod_common Common, *cc ;
cholmod_sparse *A ;
cholmod_dense *X, *B, *Residual ;
double rnorm, one [2] = {1,0}, minusone [2] = {-1,0} ;
int mtype ;
// start CHOLMOD
cc = &Common ;
cholmod_l_start (cc) ;
// load A
A = (cholmod_sparse *) cholmod_l_read_matrix (stdin, 1, &mtype, cc) ;
// B = ones (size (A,1),1)
B = cholmod_l_ones (A->nrow, 1, A->xtype, cc) ;
// X = A\B
X = SuiteSparseQR <double> (A, B, cc) ;
// rnorm = norm (B-A*X)
Residual = cholmod_l_copy_dense (B, cc) ;
cholmod_l_sdmult (A, 0, minusone, one, X, Residual, cc) ;
rnorm = cholmod_l_norm_dense (Residual, 2, cc) ;
printf ("2-norm of residual: %8.1e\n", rnorm) ;
printf ("rank %ld\n", cc->SPQR_istat [4]) ;
// free everything and finish CHOLMOD
cholmod_l_free_dense (&Residual, cc) ;
cholmod_l_free_sparse (&A, cc) ;
cholmod_l_free_dense (&X, cc) ;
cholmod_l_free_dense (&B, cc) ;
cholmod_l_finish (cc) ;
return (0) ;
mxArray *spqr_mx_put_sparse
(
cholmod_sparse **Ahandle, // CHOLMOD version of the matrix
cholmod_common *cc
)
{
mxArray *Amatlab ;
cholmod_sparse *A ;
Long nz, is_complex ;
A = *Ahandle ;
is_complex = (A->xtype != CHOLMOD_REAL) ;
Amatlab = mxCreateSparse (0, 0, 0, is_complex ? mxCOMPLEX: mxREAL) ;
mxSetM (Amatlab, A->nrow) ;
mxSetN (Amatlab, A->ncol) ;
mxSetNzmax (Amatlab, A->nzmax) ;
mxFree (mxGetJc (Amatlab)) ;
mxFree (mxGetIr (Amatlab)) ;
mxFree (mxGetPr (Amatlab)) ;
mxSetJc (Amatlab, (mwIndex *) A->p) ;
mxSetIr (Amatlab, (mwIndex *) A->i) ;
nz = cholmod_l_nnz (A, cc) ;
put_values (nz, Amatlab, (double *) A->x, is_complex, cc) ;
A->p = NULL ;
A->i = NULL ;
A->x = NULL ;
A->z = NULL ;
cholmod_l_free_sparse (Ahandle, cc) ;
return (Amatlab) ;
}
Sparse :: ~Sparse( void )
{
if( A )
{
cholmod_l_free_sparse( &A, common );
}
}
SEXP dsCMatrix_chol(SEXP x, SEXP pivot)
{
int pivP = asLogical(pivot);
CHM_FR L = internal_chm_factor(x, pivP, 0, 0, 0.);
CHM_SP R, Rt;
SEXP ans;
Rt = cholmod_l_factor_to_sparse(L, &c);
R = cholmod_l_transpose(Rt, /*values*/ 1, &c);
cholmod_l_free_sparse(&Rt, &c);
ans = PROTECT(chm_sparse_to_SEXP(R, 1/*do_free*/, 1/*uploT*/, 0/*Rkind*/,
"N"/*diag*/, GET_SLOT(x, Matrix_DimNamesSym)));
if (pivP) {
SEXP piv = PROTECT(allocVector(INTSXP, L->n));
int *dest = INTEGER(piv), *src = (int*)L->Perm;
for (int i = 0; i < L->n; i++) dest[i] = src[i] + 1;
setAttrib(ans, install("pivot"), piv);
setAttrib(ans, install("rank"), ScalarInteger((size_t) L->minor));
UNPROTECT(1);
}
cholmod_l_free_factor(&L, &c);
UNPROTECT(1);
return ans;
}
/* FIXME: Create a more general version of this operation: also for lsC, (dsR?),..
* e.g. make compressed_to_dgTMatrix() in ./dgCMatrix.c work for dsC */
SEXP dsCMatrix_to_dgTMatrix(SEXP x)
{
CHM_SP A = AS_CHM_SP__(x);
CHM_SP Afull = cholmod_l_copy(A, /*stype*/ 0, /*mode*/ 1, &c);
CHM_TR At = cholmod_l_sparse_to_triplet(Afull, &c);
R_CheckStack();
if (!A->stype)
error("Non-symmetric matrix passed to dsCMatrix_to_dgTMatrix");
cholmod_l_free_sparse(&Afull, &c);
return chm_triplet_to_SEXP(At, 1, /*uploT*/ 0, /*Rkind*/ 0, "",
GET_SLOT(x, Matrix_DimNamesSym));
}
/* Computes x'x or x x' -- *also* for Tsparse (triplet = TRUE)
see Csparse_Csparse_crossprod above for x'y and x y' */
SEXP Csparse_crossprod(SEXP x, SEXP trans, SEXP triplet)
{
int trip = asLogical(triplet),
tr = asLogical(trans); /* gets reversed because _aat is tcrossprod */
#ifdef AS_CHM_DIAGU2N_FIXED_FINALLY
CHM_TR cht = trip ? AS_CHM_TR(x) : (CHM_TR) NULL;
#else /* workaround needed:*/
SEXP xx = PROTECT(Tsparse_diagU2N(x));
CHM_TR cht = trip ? AS_CHM_TR__(xx) : (CHM_TR) NULL;
#endif
CHM_SP chcp, chxt,
chx = (trip ?
cholmod_l_triplet_to_sparse(cht, cht->nnz, &c) :
AS_CHM_SP(x));
SEXP dn = PROTECT(allocVector(VECSXP, 2));
R_CheckStack();
if (!tr) chxt = cholmod_l_transpose(chx, chx->xtype, &c);
chcp = cholmod_l_aat((!tr) ? chxt : chx, (int *) NULL, 0, chx->xtype, &c);
if(!chcp) {
UNPROTECT(1);
error(_("Csparse_crossprod(): error return from cholmod_l_aat()"));
}
cholmod_l_band_inplace(0, chcp->ncol, chcp->xtype, chcp, &c);
chcp->stype = 1;
if (trip) cholmod_l_free_sparse(&chx, &c);
if (!tr) cholmod_l_free_sparse(&chxt, &c);
SET_VECTOR_ELT(dn, 0, /* establish dimnames */
duplicate(VECTOR_ELT(GET_SLOT(x, Matrix_DimNamesSym),
(tr) ? 0 : 1)));
SET_VECTOR_ELT(dn, 1, duplicate(VECTOR_ELT(dn, 0)));
#ifdef AS_CHM_DIAGU2N_FIXED_FINALLY
UNPROTECT(1);
#else
UNPROTECT(2);
#endif
return chm_sparse_to_SEXP(chcp, 1, 0, 0, "", dn);
}
cholmod_sparse* Sparse :: operator*( void )
{
if( A )
{
cholmod_l_free_sparse( &A, common );
A = NULL;
}
int nzmax = data.size();
int sorted = true;
int packed = true;
A = cholmod_l_allocate_sparse( m, n, nzmax, sorted, packed, stype, xtype, common );
// build compressed matrix (note that EntryMap stores entries in column-major order)
double* pr = (double*) A->x;
double* pi = (double*) A->z;
UF_long* ir = (UF_long*) A->i;
UF_long* jc = (UF_long*) A->p;
int i = 0;
int j = -1;
for( EntryMap::const_iterator e = data.begin(); e != data.end(); e++ )
{
int c = e->first.first;
if( c != j )
{
for( int k = j+1; k <= c; k++ )
{
jc[k] = i;
}
j = c;
}
ir[i] = e->first.second;
pr[i] = e->second.first;
if( xtype == CHOLMOD_ZOMPLEX )
{
pi[i] = e->second.second;
}
i++;
}
for( int k = j+1; k <= n; k++ )
{
jc[k] = i;
}
return A;
}
void evaluateSVDSPQRSolver(const Eigen::MatrixXd& A, const Eigen::VectorXd& b,
const Eigen::VectorXd& x, double tol = 1e-9) {
cholmod_common cholmod;
cholmod_l_start(&cholmod);
cholmod_sparse* A_CS = aslam::calibration::eigenDenseToCholmodSparseCopy(A,
&cholmod);
cholmod_dense b_CD;
aslam::calibration::eigenDenseToCholmodDenseView(b, &b_CD);
Eigen::VectorXd x_est;
aslam::calibration::LinearSolver linearSolver;
for (std::ptrdiff_t i = 1; i < A.cols(); ++i) {
// double before = aslam::calibration::Timestamp::now();
linearSolver.solve(A_CS, &b_CD, i, x_est);
// double after = aslam::calibration::Timestamp::now();
double error = (b - A * x_est).norm();
// std::cout << std::fixed << std::setprecision(18) << "noscale: " << "error: "
// << error << " est_diff: " << (x - x_est).norm() << " time: "
// << after - before << std::endl;
ASSERT_NEAR(error, 0, tol);
linearSolver.getOptions().columnScaling = true;
// before = aslam::calibration::Timestamp::now();
linearSolver.solve(A_CS, &b_CD, i, x_est);
// after = aslam::calibration::Timestamp::now();
error = (b - A * x_est).norm();
// std::cout << std::fixed << std::setprecision(18) << "onscale: " << "error: "
// << error << " est_diff: " << (x - x_est).norm() << " time: "
// << after - before << std::endl;
linearSolver.getOptions().columnScaling = false;
ASSERT_NEAR(error, 0, tol);
// std::cout << "SVD rank: " << linearSolver.getSVDRank() << std::endl;
// std::cout << "SVD rank deficiency: " << linearSolver.getSVDRankDeficiency()
// << std::endl;
// std::cout << "QR rank: " << linearSolver.getQRRank() << std::endl;
// std::cout << "QR rank deficiency: "
// << linearSolver.getQRRankDeficiency() << std::endl;
// std::cout << "SV gap: " << linearSolver.getSvGap() << std::endl;
}
cholmod_l_free_sparse(&A_CS, &cholmod);
cholmod_l_finish(&cholmod);
}
int main (void)
{
cholmod_sparse *A ;
cholmod_common ch ;
cholmod_l_start (&ch) ;
A = cholmod_l_read_sparse (stdin, &ch) ;
if (A)
{
if (A->nrow != A->ncol || A->stype != 0
|| (!(A->xtype == CHOLMOD_REAL || A->xtype == CHOLMOD_COMPLEX)))
{
printf ("invalid matrix\n") ;
}
else
{
klu_l_demo (A->nrow, A->p, A->i, A->x, A->xtype == CHOLMOD_REAL) ;
}
cholmod_l_free_sparse (&A, &ch) ;
}
cholmod_l_finish (&ch) ;
return (0) ;
}
SEXP Csparse_diagU2N(SEXP x)
{
const char *cl = class_P(x);
/* dtCMatrix, etc; [1] = the second character =?= 't' for triangular */
if (cl[1] != 't' || *diag_P(x) != 'U') {
/* "trivially fast" when not triangular (<==> no 'diag' slot),
or not *unit* triangular */
return (x);
}
else { /* unit triangular (diag='U'): "fill the diagonal" & diag:= "N" */
CHM_SP chx = AS_CHM_SP__(x);
CHM_SP eye = cholmod_l_speye(chx->nrow, chx->ncol, chx->xtype, &c);
double one[] = {1, 0};
CHM_SP ans = cholmod_l_add(chx, eye, one, one, TRUE, TRUE, &c);
int uploT = (*uplo_P(x) == 'U') ? 1 : -1;
int Rkind = (chx->xtype != CHOLMOD_PATTERN) ? Real_kind(x) : 0;
R_CheckStack();
cholmod_l_free_sparse(&eye, &c);
return chm_sparse_to_SEXP(ans, 1, uploT, Rkind, "N",
GET_SLOT(x, Matrix_DimNamesSym));
}
}
SEXP Csparse_Csparse_crossprod(SEXP a, SEXP b, SEXP trans)
{
int tr = asLogical(trans);
CHM_SP
cha = AS_CHM_SP(a),
chb = AS_CHM_SP(b),
chTr, chc;
const char *cl_a = class_P(a), *cl_b = class_P(b);
char diag[] = {'\0', '\0'};
int uploT = 0;
SEXP dn = PROTECT(allocVector(VECSXP, 2));
R_CheckStack();
chTr = cholmod_l_transpose((tr) ? chb : cha, chb->xtype, &c);
chc = cholmod_l_ssmult((tr) ? cha : chTr, (tr) ? chTr : chb,
/*out_stype:*/ 0, cha->xtype, /*out sorted:*/ 1, &c);
cholmod_l_free_sparse(&chTr, &c);
/* Preserve triangularity and unit-triangularity if appropriate;
* see Csparse_Csparse_prod() for comments */
if (cl_a[1] == 't' && cl_b[1] == 't')
if(*uplo_P(a) != *uplo_P(b)) { /* one 'U', the other 'L' */
uploT = (*uplo_P(b) == 'U') ? 1 : -1;
if(*diag_P(a) == 'U' && *diag_P(b) == 'U') { /* return UNIT-triag. */
chm_diagN2U(chc, uploT, /* do_realloc */ FALSE);
diag[0]= 'U';
}
else diag[0]= 'N';
}
SET_VECTOR_ELT(dn, 0, /* establish dimnames */
duplicate(VECTOR_ELT(GET_SLOT(a, Matrix_DimNamesSym), (tr) ? 0 : 1)));
SET_VECTOR_ELT(dn, 1,
duplicate(VECTOR_ELT(GET_SLOT(b, Matrix_DimNamesSym), (tr) ? 0 : 1)));
UNPROTECT(1);
return chm_sparse_to_SEXP(chc, 1, uploT, /*Rkind*/0, diag, dn);
}
void mexFunction
(
int nargout,
mxArray *pargout [ ],
int nargin,
const mxArray *pargin [ ]
)
{
double dummy = 0 ;
cholmod_factor *L ;
cholmod_sparse *A, Amatrix, *C, *S ;
cholmod_common Common, *cm ;
Long n, transpose, c ;
char buf [LEN] ;
/* ---------------------------------------------------------------------- */
/* start CHOLMOD and set defaults */
/* ---------------------------------------------------------------------- */
cm = &Common ;
cholmod_l_start (cm) ;
sputil_config (SPUMONI, cm) ;
/* only do the simplicial analysis (L->Perm and L->ColCount) */
cm->supernodal = CHOLMOD_SIMPLICIAL ;
/* ---------------------------------------------------------------------- */
/* get inputs */
/* ---------------------------------------------------------------------- */
if (nargout > 2 || nargin < 1 || nargin > 3)
{
mexErrMsgTxt ("Usage: [p count] = analyze (A, mode)") ;
}
if (nargin == 3)
{
cm->nmethods = mxGetScalar (pargin [2]) ;
if (cm->nmethods == -1)
{
/* use AMD only */
cm->nmethods = 1 ;
cm->method [0].ordering = CHOLMOD_AMD ;
cm->postorder = TRUE ;
}
else if (cm->nmethods == -2)
{
/* use METIS only */
cm->nmethods = 1 ;
cm->method [0].ordering = CHOLMOD_METIS ;
cm->postorder = TRUE ;
}
else if (cm->nmethods == -3)
{
/* use NESDIS only */
cm->nmethods = 1 ;
cm->method [0].ordering = CHOLMOD_NESDIS ;
cm->postorder = TRUE ;
}
}
/* ---------------------------------------------------------------------- */
/* get input matrix A */
/* ---------------------------------------------------------------------- */
A = sputil_get_sparse_pattern (pargin [0], &Amatrix, &dummy, cm) ;
S = (A == &Amatrix) ? NULL : A ;
/* ---------------------------------------------------------------------- */
/* get A->stype, default is to use tril(A) */
/* ---------------------------------------------------------------------- */
A->stype = -1 ;
transpose = FALSE ;
if (nargin > 1)
{
buf [0] = '\0' ;
if (mxIsChar (pargin [1]))
{
mxGetString (pargin [1], buf, LEN) ;
}
c = buf [0] ;
if (tolower (c) == 'r')
{
/* unsymmetric case (A*A') if string starts with 'r' */
transpose = FALSE ;
A->stype = 0 ;
}
else if (tolower (c) == 'c')
{
/* unsymmetric case (A'*A) if string starts with 'c' */
transpose = TRUE ;
A->stype = 0 ;
}
else if (tolower (c) == 's')
{
/* symmetric case (A) if string starts with 's' */
transpose = FALSE ;
A->stype = -1 ;
}
else
{
mexErrMsgTxt ("analyze: unrecognized mode") ;
}
}
if (A->stype && A->nrow != A->ncol)
{
mexErrMsgTxt ("analyze: A must be square") ;
}
C = NULL ;
if (transpose)
{
/* C = A', and then order C*C' */
C = cholmod_l_transpose (A, 0, cm) ;
if (C == NULL)
{
mexErrMsgTxt ("analyze failed") ;
}
A = C ;
}
n = A->nrow ;
/* ---------------------------------------------------------------------- */
/* analyze and order the matrix */
/* ---------------------------------------------------------------------- */
L = cholmod_l_analyze (A, cm) ;
/* ---------------------------------------------------------------------- */
/* return Perm */
/* ---------------------------------------------------------------------- */
pargout [0] = sputil_put_int (L->Perm, n, 1) ;
if (nargout > 1)
{
pargout [1] = sputil_put_int (L->ColCount, n, 0) ;
}
/* ---------------------------------------------------------------------- */
/* free workspace */
/* ---------------------------------------------------------------------- */
cholmod_l_free_factor (&L, cm) ;
cholmod_l_free_sparse (&C, cm) ;
cholmod_l_free_sparse (&S, cm) ;
cholmod_l_finish (cm) ;
cholmod_l_print_common (" ", cm) ;
/* if (cm->malloc_count != 0) mexErrMsgTxt ("!") ; */
}
void mexFunction
(
int nargout,
mxArray *pargout [ ],
int nargin,
const mxArray *pargin [ ]
)
{
Int *P, *Q, *Rp, *Pinv ;
double *Ax, dummy, tol ;
Int m, n, anz, is_complex, n1rows, n1cols, i, k ;
cholmod_sparse *A, Amatrix, *Y ;
cholmod_common Common, *cc ;
// -------------------------------------------------------------------------
// start CHOLMOD and set parameters
// -------------------------------------------------------------------------
cc = &Common ;
cholmod_l_start (cc) ;
spqr_mx_config (SPUMONI, cc) ;
// -------------------------------------------------------------------------
// check inputs
// -------------------------------------------------------------------------
if (nargout > 5)
{
mexErrMsgIdAndTxt ("MATLAB:maxlhs", "Too many output arguments") ;
}
if (nargin < 1)
{
mexErrMsgIdAndTxt ("MATLAB:minrhs", "Not enough input arguments") ;
}
if (nargin > 2)
{
mexErrMsgIdAndTxt ("MATLAB:maxrhs", "Too many input arguments") ;
}
// -------------------------------------------------------------------------
// get the input matrix A and convert to merged-complex if needed
// -------------------------------------------------------------------------
if (!mxIsSparse (pargin [0]))
{
mexErrMsgIdAndTxt ("QR:invalidInput", "A must be sparse") ;
}
A = spqr_mx_get_sparse (pargin [0], &Amatrix, &dummy) ;
m = A->nrow ;
n = A->ncol ;
is_complex = mxIsComplex (pargin [0]) ;
Ax = spqr_mx_merge_if_complex (pargin [0], is_complex, &anz, cc) ;
if (is_complex)
{
// A has been converted from real or zomplex to complex
A->x = Ax ;
A->z = NULL ;
A->xtype = CHOLMOD_COMPLEX ;
}
// -------------------------------------------------------------------------
// get the tolerance
// -------------------------------------------------------------------------
if (nargin < 2)
{
tol = is_complex ? spqr_tol <Complex> (A,cc) : spqr_tol <double> (A,cc);
}
else
{
tol = mxGetScalar (pargin [1]) ;
}
// -------------------------------------------------------------------------
// find the singletons
// -------------------------------------------------------------------------
if (is_complex)
{
spqr_1colamd <Complex> (SPQR_ORDERING_NATURAL, tol, 0, A,
&Q, &Rp, &Pinv, &Y, &n1cols, &n1rows, cc) ;
}
else
{
spqr_1colamd <double> (SPQR_ORDERING_NATURAL, tol, 0, A,
&Q, &Rp, &Pinv, &Y, &n1cols, &n1rows, cc) ;
}
// -------------------------------------------------------------------------
// free unused outputs from spqr_1colamd, and the merged-complex copy of A
// -------------------------------------------------------------------------
cholmod_l_free (n1rows+1, sizeof (Int), Rp, cc) ;
cholmod_l_free_sparse (&Y, cc) ;
if (is_complex)
{
// this was allocated by merge_if_complex
cholmod_l_free (anz, sizeof (Complex), Ax, cc) ;
}
// -------------------------------------------------------------------------
// find P from Pinv
// -------------------------------------------------------------------------
P = (Int *) cholmod_l_malloc (m, sizeof (Int), cc) ;
for (i = 0 ; i < m ; i++)
{
k = Pinv ? Pinv [i] : i ;
P [k] = i ;
}
cholmod_l_free (m, sizeof (Int), Pinv, cc) ;
// -------------------------------------------------------------------------
// return results
// -------------------------------------------------------------------------
pargout [0] = spqr_mx_put_permutation (P, m, TRUE, cc) ;
cholmod_l_free (m, sizeof (Int), P, cc) ;
if (nargout > 1) pargout [1] = spqr_mx_put_permutation (Q, n, TRUE, cc) ;
cholmod_l_free (n, sizeof (Int), Q, cc) ;
if (nargout > 2) pargout [2] = mxCreateDoubleScalar ((double) n1rows) ;
if (nargout > 3) pargout [3] = mxCreateDoubleScalar ((double) n1cols) ;
if (nargout > 4) pargout [4] = mxCreateDoubleScalar (tol) ;
cholmod_l_finish (cc) ;
}
void mexFunction
(
int nargout,
mxArray *pargout [ ],
int nargin,
const mxArray *pargin [ ]
)
{
#ifndef NPARTITION
double dummy = 0 ;
Long *Perm ;
cholmod_sparse *A, Amatrix, *C, *S ;
cholmod_common Common, *cm ;
Long n, transpose, c, postorder ;
char buf [LEN] ;
/* ---------------------------------------------------------------------- */
/* start CHOLMOD and set defaults */
/* ---------------------------------------------------------------------- */
cm = &Common ;
cholmod_l_start (cm) ;
sputil_config (SPUMONI, cm) ;
/* ---------------------------------------------------------------------- */
/* get inputs */
/* ---------------------------------------------------------------------- */
if (nargout > 1 || nargin < 1 || nargin > 3)
{
mexErrMsgTxt ("Usage: p = metis (A, mode)") ;
}
/* ---------------------------------------------------------------------- */
/* get input matrix A */
/* ---------------------------------------------------------------------- */
A = sputil_get_sparse_pattern (pargin [0], &Amatrix, &dummy, cm) ;
S = (A == &Amatrix) ? NULL : A ;
/* ---------------------------------------------------------------------- */
/* get A->stype, default is to use tril(A) */
/* ---------------------------------------------------------------------- */
A->stype = -1 ;
transpose = FALSE ;
if (nargin > 1)
{
buf [0] = '\0' ;
if (mxIsChar (pargin [1]))
{
mxGetString (pargin [1], buf, LEN) ;
}
c = buf [0] ;
if (tolower (c) == 'r')
{
/* unsymmetric case (A*A') if string starts with 'r' */
transpose = FALSE ;
A->stype = 0 ;
}
else if (tolower (c) == 'c')
{
/* unsymmetric case (A'*A) if string starts with 'c' */
transpose = TRUE ;
A->stype = 0 ;
}
else if (tolower (c) == 's')
{
/* symmetric case (A) if string starts with 's' */
transpose = FALSE ;
A->stype = -1 ;
}
else
{
mexErrMsgTxt ("metis: p=metis(A,mode) ; unrecognized mode") ;
}
}
if (A->stype && A->nrow != A->ncol)
{
mexErrMsgTxt ("metis: A must be square") ;
}
C = NULL ;
if (transpose)
{
/* C = A', and then order C*C' with METIS */
C = cholmod_l_transpose (A, 0, cm) ;
if (C == NULL)
{
mexErrMsgTxt ("metis failed") ;
}
A = C ;
}
n = A->nrow ;
/* ---------------------------------------------------------------------- */
/* get workspace */
/* ---------------------------------------------------------------------- */
Perm = cholmod_l_malloc (n, sizeof (Long), cm) ;
/* ---------------------------------------------------------------------- */
/* order the matrix with CHOLMOD's interface to METIS_NodeND */
/* ---------------------------------------------------------------------- */
postorder = (nargin < 3) ;
if (!cholmod_l_metis (A, NULL, 0, postorder, Perm, cm))
{
mexErrMsgTxt ("metis failed") ;
return ;
}
/* ---------------------------------------------------------------------- */
/* return Perm */
/* ---------------------------------------------------------------------- */
pargout [0] = sputil_put_int (Perm, n, 1) ;
/* ---------------------------------------------------------------------- */
/* free workspace */
/* ---------------------------------------------------------------------- */
cholmod_l_free (n, sizeof (Long), Perm, cm) ;
cholmod_l_free_sparse (&C, cm) ;
cholmod_l_free_sparse (&S, cm) ;
cholmod_l_finish (cm) ;
cholmod_l_print_common (" ", cm) ;
/*
if (cm->malloc_count != 0) mexErrMsgTxt ("!") ;
*/
#else
mexErrMsgTxt ("METIS and the CHOLMOD Partition Module not installed\n") ;
#endif
}
template <typename Entry> SuiteSparseQR_factorization <Entry> *spqr_1factor
(
// inputs, not modified
int ordering, // all, except 3:given treated as 0:fixed
double tol, // only accept singletons above tol. If tol <= -2,
// then use the default tolerance
Int bncols, // number of columns of B
int keepH, // if TRUE, keep the Householder vectors
cholmod_sparse *A, // m-by-n sparse matrix
Int ldb, // if dense, the leading dimension of B
Int *Bp, // size bncols+1, column pointers of B
Int *Bi, // size bnz = Bp [bncols], row indices of B
Entry *Bx, // size bnz, numerical values of B
// workspace and parameters
cholmod_common *cc
)
{
spqr_symbolic *QRsym ;
spqr_numeric <Entry> *QRnum ;
SuiteSparseQR_factorization <Entry> *QR ;
Int *Yp, *Yi, *Q1fill, *R1p, *R1j, *P1inv, *Ap, *Ai ;
Entry *Yx, *R1x, *Ax ;
Int noY, anz, a2nz, r1nz, ynz, i, j, k, p, p2, bnz, py, n1rows,
n1cols, n2, Bsparse, d, iold, inew, m, n ;
cholmod_sparse *Y ;
#ifdef TIMING
double t0 = spqr_time ( ) ;
double t1, t2 ;
#endif
// -------------------------------------------------------------------------
// get inputs and allocate result
// -------------------------------------------------------------------------
m = A->nrow ;
n = A->ncol ;
Ap = (Int *) A->p ;
Ai = (Int *) A->i ;
Ax = (Entry *) A->x ;
QR = (SuiteSparseQR_factorization <Entry> *)
cholmod_l_malloc (1, sizeof (SuiteSparseQR_factorization <Entry>), cc) ;
if (cc->status < CHOLMOD_OK)
{
// out of memory
return (NULL) ;
}
QR->QRsym = NULL ;
QR->QRnum = NULL ;
QR->R1p = NULL ;
QR->R1j = NULL ;
QR->R1x = NULL ;
QR->P1inv = NULL ;
QR->Q1fill = NULL ;
QR->Rmap = NULL ;
QR->RmapInv = NULL ;
QR->HP1inv = NULL ;
QR->narows = m ;
QR->nacols = n ;
QR->bncols = bncols ;
QR->n1rows = 0 ;
QR->n1cols = 0 ;
QR->r1nz = 0 ;
r1nz = 0 ;
// B is an optional input. It can be sparse or dense
Bsparse = (Bp != NULL && Bi != NULL) ;
if (Bx == NULL)
{
// B is not present; force bncols to be zero
bncols = 0 ;
}
// -------------------------------------------------------------------------
// find the default tol, if requested
// -------------------------------------------------------------------------
if (tol <= SPQR_DEFAULT_TOL)
{
tol = spqr_tol <Entry> (A, cc) ;
}
if (tol < 0)
{
// no rank detection will be performed
QR->allow_tol = FALSE ;
tol = EMPTY ;
}
else
{
QR->allow_tol = TRUE ;
}
QR->tol = tol ;
// -------------------------------------------------------------------------
// find singletons and construct column pointers for the A part of Y
// -------------------------------------------------------------------------
// These return R1p, P1inv, and Y; but they are all NULL if out of memory.
// Note that only Y->p is allocated (Y->i and Y->x are dummy placeholders
// of one Int and one Entry, each, actually). The entries of Y are
// allocated later, below.
if (ordering == SPQR_ORDERING_GIVEN)
{
ordering = SPQR_ORDERING_FIXED ;
}
if (ordering == SPQR_ORDERING_FIXED)
{
// fixed ordering: find column singletons without permuting columns
Q1fill = NULL ;
spqr_1fixed <Entry> (tol, bncols, A,
&R1p, &P1inv, &Y, &n1cols, &n1rows, cc) ;
}
else
{
// natural or fill-reducing ordering: find column singletons with
// column permutations allowed, then permute the pruned submatrix with
// a fill-reducing ordering if ordering is not SPQR_ORDERING_NATURAL.
spqr_1colamd <Entry> (ordering, tol, bncols, A, &Q1fill,
&R1p, &P1inv, &Y, &n1cols, &n1rows, cc) ;
ordering = cc->SPQR_istat [7] ;
}
if (cc->status < CHOLMOD_OK)
{
// out of memory
spqr_freefac (&QR, cc) ;
return (NULL) ;
}
QR->R1p = R1p ;
QR->P1inv = P1inv ;
QR->Q1fill = Q1fill ;
QR->n1rows = n1rows ;
QR->n1cols = n1cols ;
noY = (Y == NULL) ; // A will be factorized, not Y
ASSERT (noY == (n1cols == 0 && bncols == 0)) ;
Yp = noY ? NULL : (Int *) Y->p ;
anz = Ap [n] ; // nonzeros in A
a2nz = noY ? anz : Yp [n-n1cols] ; // nonzeros in S2
n2 = n - n1cols ; // number of columns of S2
// Y is NULL, or of size (m-n1rows)-by-(n-n1cols+bncols)
ASSERT (IMPLIES (Y != NULL, ((Int) Y->nrow == m-n1rows))) ;
ASSERT (IMPLIES (Y != NULL, ((Int) Y->ncol == n-n1cols+bncols))) ;
// Y, if allocated, has no space for any entries yet
ynz = 0 ;
// -------------------------------------------------------------------------
// construct the column pointers for the B or B2 part of Y
// -------------------------------------------------------------------------
if (noY)
{
// A will be factorized instead of Y. There is no B. C or X can exist
// as empty matrices with rows but no columns
ASSERT (Yp == NULL) ;
ASSERT (R1p == NULL) ;
ASSERT (P1inv == NULL) ;
ASSERT (n1rows == 0) ;
ASSERT (a2nz == Ap [n]) ;
ASSERT (bncols == 0) ;
}
else if (n1cols == 0)
{
// ---------------------------------------------------------------------
// construct the column pointers for the B part of Y = [S B]
// ---------------------------------------------------------------------
ASSERT (R1p == NULL) ;
ASSERT (P1inv == NULL) ;
ASSERT (n1rows == 0) ;
ASSERT (a2nz == Ap [n]) ;
ynz = a2nz ;
if (Bsparse)
{
// B is sparse
for (k = 0 ; k < bncols ; k++)
{
Yp [(n-n1cols)+k] = ynz ;
d = Bp [k+1] - Bp [k] ;
ynz += d ;
}
}
else
{
// B is dense
Entry *B1 = Bx ;
for (k = 0 ; k < bncols ; k++)
{
// count the nonzero entries in column k of B
Yp [(n-n1cols)+k] = ynz ;
d = 0 ;
for (i = 0 ; i < m ; i++)
{
if (B1 [i] != (Entry) 0)
{
d++ ;
}
}
B1 += ldb ;
ynz += d ;
}
}
Yp [(n-n1cols)+bncols] = ynz ;
}
else
{
// ---------------------------------------------------------------------
// construct the column pointers for the B2 part of Y = [S2 B2]
// ---------------------------------------------------------------------
ynz = a2nz ;
if (Bsparse)
{
// B is sparse
for (k = 0 ; k < bncols ; k++)
{
// count the nonzero entries in column k of B2
Yp [(n-n1cols)+k] = ynz ;
d = 0 ;
for (p = Bp [k] ; p < Bp [k+1] ; p++)
{
iold = Bi [p] ;
inew = P1inv [iold] ;
if (inew >= n1rows)
{
d++ ;
}
}
ynz += d ;
}
}
else
{
// B is dense
Entry *B1 = Bx ;
for (k = 0 ; k < bncols ; k++)
{
// count the nonzero entries in column k of B2
Yp [(n-n1cols)+k] = ynz ;
d = 0 ;
for (iold = 0 ; iold < m ; iold++)
{
inew = P1inv [iold] ;
if (inew >= n1rows && B1 [iold] != (Entry) 0)
{
d++ ;
}
}
B1 += ldb ;
ynz += d ;
}
}
Yp [(n-n1cols)+bncols] = ynz ;
}
// -------------------------------------------------------------------------
// allocate the nonzeros for Y
// -------------------------------------------------------------------------
if (noY)
{
// no singletons found, and B is empty. pass Y=A to QR factorization,
// and pass in Q1fill as the "user-provided" ordering
ASSERT (Yp == NULL) ;
Yi = NULL ;
Yx = NULL ;
}
else
{
cholmod_l_reallocate_sparse (ynz, Y, cc) ;
Yi = (Int *) Y->i ;
Yx = (Entry *) Y->x ;
}
if (cc->status < CHOLMOD_OK)
{
// out of memory
spqr_freefac (&QR, cc) ;
cholmod_l_free_sparse (&Y, cc) ;
return (NULL) ;
}
// -------------------------------------------------------------------------
// create the pattern and values of Y and R1
// -------------------------------------------------------------------------
if (noY)
{
// ---------------------------------------------------------------------
// R1 does not exist
// ---------------------------------------------------------------------
ASSERT (R1p == NULL) ;
R1j = NULL ;
R1x = NULL ;
}
else if (n1cols == 0)
{
// ---------------------------------------------------------------------
// R1 does not exist
// ---------------------------------------------------------------------
ASSERT (R1p == NULL) ;
R1j = NULL ;
R1x = NULL ;
// ---------------------------------------------------------------------
// construct the A part of Y = [S B]
// ---------------------------------------------------------------------
ASSERT (anz == a2nz) ;
py = 0 ;
for (k = 0 ; k < n ; k++)
{
j = Q1fill ? Q1fill [k] : k ;
ASSERT (py == Yp [k]) ;
for (p = Ap [j] ; p < Ap [j+1] ; p++)
{
Yi [py] = Ai [p] ;
Yx [py] = Ax [p] ;
py++ ;
}
}
ASSERT (py == anz) ;
ASSERT (py == Yp [n]) ;
// ---------------------------------------------------------------------
// construct the B part of Y = [S B]
// ---------------------------------------------------------------------
if (Bsparse)
{
// B is sparse
bnz = Bp [bncols] ;
for (p = 0 ; p < bnz ; p++)
{
Yi [py++] = Bi [p] ;
}
py = anz ;
for (p = 0 ; p < bnz ; p++)
{
Yx [py++] = Bx [p] ;
}
}
else
{
// B is dense
Entry *B1 = Bx ;
for (k = 0 ; k < bncols ; k++)
{
ASSERT (py == Yp [n+k]) ;
for (i = 0 ; i < m ; i++)
{
Entry bij = B1 [i] ;
if (bij != (Entry) 0)
{
Yi [py] = i ;
Yx [py] = bij ;
py++ ;
}
}
B1 += ldb ;
}
}
ASSERT (py == ynz) ;
}
else
{
// ---------------------------------------------------------------------
// R1p = cumsum ([0 R1p])
// ---------------------------------------------------------------------
r1nz = spqr_cumsum (n1rows, R1p) ; // Int overflow cannot occur
PR (("total nonzeros in R1: %ld\n", r1nz)) ;
// ---------------------------------------------------------------------
// allocate R1
// ---------------------------------------------------------------------
R1j = (Int *) cholmod_l_malloc (r1nz, sizeof (Int ), cc) ;
R1x = (Entry *) cholmod_l_malloc (r1nz, sizeof (Entry), cc) ;
QR->R1j = R1j ;
QR->R1x = R1x ;
QR->r1nz = r1nz ;
if (cc->status < CHOLMOD_OK)
{
// out of memory
spqr_freefac (&QR, cc) ;
cholmod_l_free_sparse (&Y, cc) ;
return (NULL) ;
}
// ---------------------------------------------------------------------
// scan A and construct R11
// ---------------------------------------------------------------------
// At this point, R1p [i] points to the start of row i:
// for (Int t = 0 ; t <= n1rows ; t++) Rsave [t] = R1p [t] ;
for (k = 0 ; k < n1cols ; k++)
{
j = Q1fill ? Q1fill [k] : k ;
for (p = Ap [j] ; p < Ap [j+1] ; p++)
{
// row i of A is row inew after singleton permutation
i = Ai [p] ;
inew = P1inv [i] ;
ASSERT (inew < n1rows) ;
// A (i,j) is in a singleton row. It becomes R1 (inew,k)
p2 = R1p [inew]++ ;
ASSERT (p2 < R1p [inew+1]) ;
R1j [p2] = k ;
R1x [p2] = Ax [p] ;
}
}
// ---------------------------------------------------------------------
// scan A and construct R12 and the S2 part of Y = [S2 B2]
// ---------------------------------------------------------------------
py = 0 ;
for ( ; k < n ; k++)
{
j = Q1fill ? Q1fill [k] : k ;
ASSERT (py == Yp [k-n1cols]) ;
for (p = Ap [j] ; p < Ap [j+1] ; p++)
{
// row i of A is row inew after singleton permutation
i = Ai [p] ;
inew = P1inv [i] ;
if (inew < n1rows)
{
// A (i,j) is in a singleton row. It becomes R1 (inew,k)
p2 = R1p [inew]++ ;
ASSERT (p2 < R1p [inew+1]) ;
R1j [p2] = k ;
R1x [p2] = Ax [p] ;
}
else
{
// A (i,j) is not in a singleton row. Place it in
// Y (inew-n1rows, k-n1cols)
Yi [py] = inew - n1rows ;
Yx [py] = Ax [p] ;
py++ ;
}
}
}
ASSERT (py == Yp [n-n1cols]) ;
// ---------------------------------------------------------------------
// restore the row pointers for R1
// ---------------------------------------------------------------------
spqr_shift (n1rows, R1p) ;
// the row pointers are back to what they were:
// for (Int t = 0 ; t <= n1rows ; t++) ASSERT (Rsave [t] == R1p [t]) ;
// ---------------------------------------------------------------------
// construct the B2 part of Y = [S2 B2]
// ---------------------------------------------------------------------
if (Bsparse)
{
// B is sparse
for (k = 0 ; k < bncols ; k++)
{
// construct the nonzero entries in column k of B2
ASSERT (py == Yp [k+(n-n1cols)]) ;
for (p = Bp [k] ; p < Bp [k+1] ; p++)
{
iold = Bi [p] ;
inew = P1inv [iold] ;
if (inew >= n1rows)
{
Yi [py] = inew - n1rows ;
Yx [py] = Bx [p] ;
py++ ;
}
}
}
}
else
{
// B is dense
Entry *B1 = Bx ;
for (k = 0 ; k < bncols ; k++)
{
// construct the nonzero entries in column k of B2
ASSERT (py == Yp [k+(n-n1cols)]) ;
for (iold = 0 ; iold < m ; iold++)
{
inew = P1inv [iold] ;
if (inew >= n1rows)
{
Entry bij = B1 [iold] ;
if (bij != (Entry) 0)
{
Yi [py] = inew - n1rows ;
Yx [py] = bij ;
py++ ;
}
}
}
B1 += ldb ;
}
}
ASSERT (py == ynz) ;
}
// -------------------------------------------------------------------------
// QR factorization of A or Y
// -------------------------------------------------------------------------
if (noY)
{
// factorize A, with fill-reducing ordering already given in Q1fill
QRsym = spqr_analyze (A, SPQR_ORDERING_GIVEN, Q1fill,
tol >= 0, keepH, cc) ;
#ifdef TIMING
t1 = spqr_time ( ) ;
#endif
QRnum = spqr_factorize <Entry> (&A, FALSE, tol, n, QRsym, cc) ;
}
else
{
// fill-reducing ordering is already applied to Y; free Y when loaded
QRsym = spqr_analyze (Y, SPQR_ORDERING_FIXED, NULL,
tol >= 0, keepH, cc) ;
#ifdef TIMING
t1 = spqr_time ( ) ;
#endif
QRnum = spqr_factorize <Entry> (&Y, TRUE, tol, n2, QRsym, cc) ;
// Y has been freed
ASSERT (Y == NULL) ;
}
// record the actual ordering used (this will have been changed to GIVEN
// or FIXED, in spqr_analyze, but change it back to the ordering used by
// spqr_1fixed or spqr_1colamd.
cc->SPQR_istat [7] = ordering ;
QR->QRsym = QRsym ;
QR->QRnum = QRnum ;
if (cc->status < CHOLMOD_OK)
{
// out of memory
spqr_freefac (&QR, cc) ;
return (NULL) ;
}
cc->SPQR_istat [0] += r1nz ; // nnz (R)
// rank estimate of A, including singletons but excluding the columns of
// of B, in case [A B] was factorized.
QR->rank = n1rows + QRnum->rank1 ;
// -------------------------------------------------------------------------
// construct global row permutation if H is kept and singletons exist
// -------------------------------------------------------------------------
// If there are no singletons, then HP1inv [0:m-1] and HPinv [0:m-1] would
// be identical, so HP1inv is not needed.
ASSERT ((n1cols == 0) == (P1inv == NULL)) ;
ASSERT (IMPLIES (n1cols == 0, n1rows == 0)) ;
if (keepH && n1cols > 0)
{
// construct the global row permutation. Currently, the row indices
// in H reflect the global R. P1inv is the singleton permutation,
// where a row index of Y = (P1inv (row of A) - n1rows), and
// row of R2 = QRnum->HPinv (row of Y). Combine these two into
// HP1inv, where a global row of R = HP1inv (a row of A)
Int kk ;
Int *HP1inv, *HPinv ;
QR->HP1inv = HP1inv = (Int *) cholmod_l_malloc (m, sizeof (Int), cc) ;
HPinv = QRnum->HPinv ;
if (cc->status < CHOLMOD_OK)
{
// out of memory
spqr_freefac (&QR, cc) ;
return (NULL) ;
}
for (i = 0 ; i < m ; i++)
{
// i is a row of A, k is a row index after row singletons are
// permuted. Then kk is a row index of the global R.
k = P1inv ? P1inv [i] : i ;
ASSERT (k >= 0 && k < m) ;
if (k < n1rows)
{
kk = k ;
}
else
{
// k-n1rows is a row index of Y, the matrix factorized by
// the QR factorization kernels (in QRsym and QRnum).
// HPinv [k-n1rows] gives a row index of R2, to which n1rows
// must be added to give a row of the global R.
kk = HPinv [k - n1rows] + n1rows ;
}
ASSERT (kk >= 0 && kk < m) ;
HP1inv [i] = kk ;
}
}
// -------------------------------------------------------------------------
// find the mapping for the squeezed R, if A is rank deficient
// -------------------------------------------------------------------------
if (QR->rank < n && !spqr_rmap <Entry> (QR, cc))
{
// out of memory
spqr_freefac (&QR, cc) ;
return (NULL) ;
}
// -------------------------------------------------------------------------
// output statistics
// -------------------------------------------------------------------------
cc->SPQR_istat [4] = QR->rank ; // estimated rank of A
cc->SPQR_istat [5] = n1cols ; // number of columns singletons
cc->SPQR_istat [6] = n1rows ; // number of singleton rows
cc->SPQR_xstat [1] = tol ; // tol used
#ifdef TIMING
t2 = spqr_time ( ) ;
cc->other1 [1] = t1 - t0 ; // analyze time, including singletons
cc->other1 [2] = t2 - t1 ; // factorize time
#endif
return (QR) ;
}
template <typename Entry> int spqr_1fixed
(
// inputs, not modified
double tol, // only accept singletons above tol
Long bncols, // number of columns of B
cholmod_sparse *A, // m-by-n sparse matrix
// output arrays, neither allocated nor defined on input.
Long **p_R1p, // size n1rows+1, R1p [k] = # of nonzeros in kth
// row of R1. NULL if n1cols == 0.
Long **p_P1inv, // size m, singleton row inverse permutation.
// If row i of A is the kth singleton row, then
// P1inv [i] = k. NULL if n1cols is zero.
cholmod_sparse **p_Y, // on output, only the first n-n1cols+1 entries of
// Y->p are defined (if Y is not NULL), where
// Y = [A B] or Y = [A2 B2]. If B is empty and
// there are no column singletons, Y is NULL
Long *p_n1cols, // number of column singletons found
Long *p_n1rows, // number of corresponding rows found
// workspace and parameters
cholmod_common *cc
)
{
cholmod_sparse *Y ;
Long *P1inv, *R1p, *Yp, *Qrows, *Ap, *Ai ;
char *Mark ;
Entry *Ax ;
Long i, j, k, p, d, row, n1rows, n1cols, ynz, iold, inew, kk, m, n, xtype ;
// -------------------------------------------------------------------------
// get inputs
// -------------------------------------------------------------------------
xtype = spqr_type <Entry> ( ) ;
m = A->nrow ;
n = A->ncol ;
Ap = (Long *) A->p ;
Ai = (Long *) A->i ;
Ax = (Entry *) A->x ;
// set outputs to NULL in case of early return
*p_R1p = NULL ;
*p_P1inv = NULL ;
*p_Y = NULL ;
*p_n1cols = EMPTY ;
*p_n1rows = EMPTY ;
// -------------------------------------------------------------------------
// allocate workspace
// -------------------------------------------------------------------------
Mark = (char *) cholmod_l_calloc (m, sizeof (char), cc) ;
Qrows = (Long *) cholmod_l_malloc (n, sizeof (Long), cc) ;
if (cc->status < CHOLMOD_OK)
{
// out of memory
cholmod_l_free (m, sizeof (char), Mark, cc) ;
cholmod_l_free (n, sizeof (Long), Qrows, cc) ;
return (FALSE) ;
}
// -------------------------------------------------------------------------
// find singletons; no column permutations allowed
// -------------------------------------------------------------------------
n1cols = 0 ; // number of column singletons found
n1rows = 0 ; // number of corresponding singleton rows
for (j = 0 ; j < n ; j++)
{
// count the number of unmarked rows in column j
Entry aij = 0 ;
d = 0 ;
row = EMPTY ;
for (p = Ap [j] ; d < 2 && p < Ap [j+1] ; p++)
{
i = Ai [p] ;
if (!Mark [i])
{
// row i is not taken by a prior column singleton. If this
// is the only unflagged row and the value is large enough,
// it will become the row for this column singleton.
aij = Ax [p] ;
row = i ;
d++ ;
}
}
if (d == 0)
{
// j is a dead column singleton
Qrows [n1cols++] = EMPTY ;
}
else if (d == 1 && spqr_abs (aij, cc) > tol)
{
// j is a live column singleton
Qrows [n1cols++] = row ;
// flag row i as taken
Mark [row] = TRUE ;
n1rows++ ;
}
else
{
// j is not a singleton; quit searching
break ;
}
}
// -------------------------------------------------------------------------
// construct P1inv permutation, row counts R1p, and col pointers Yp
// -------------------------------------------------------------------------
if (n1cols == 0 && bncols == 0)
{
// ---------------------------------------------------------------------
// no singletons, and B empty; Y=A will be done via pointer alias
// ---------------------------------------------------------------------
Y = NULL ;
Yp = NULL ;
P1inv = NULL ;
R1p = NULL ;
}
else if (n1cols == 0)
{
// ---------------------------------------------------------------------
// no singletons in the matrix; no R1 matrix, no P1inv permutation
// ---------------------------------------------------------------------
// Y has no entries yet; nnz(Y) will be determined later
Y = cholmod_l_allocate_sparse (m, n+bncols, 0,
FALSE, TRUE, 0, xtype, cc) ;
if (cc->status < CHOLMOD_OK)
{
// out of memory
cholmod_l_free (m, sizeof (char), Mark, cc) ;
cholmod_l_free (n, sizeof (Long), Qrows, cc) ;
return (FALSE) ;
}
Yp = (Long *) Y->p ;
ASSERT (n1rows == 0) ;
P1inv = NULL ;
R1p = NULL ;
// ---------------------------------------------------------------------
// copy the column pointers of A for the first part of Y = [A B]
// ---------------------------------------------------------------------
ynz = Ap [n] ;
for (k = 0 ; k <= n ; k++)
{
Yp [k] = Ap [k] ;
}
}
else
{
// ---------------------------------------------------------------------
// construct the row singleton permutation
// ---------------------------------------------------------------------
// Y has no entries yet; nnz(Y) will be determined later
Y = cholmod_l_allocate_sparse (m-n1rows, n-n1cols+bncols, 0,
TRUE, TRUE, 0, xtype, cc) ;
P1inv = (Long *) cholmod_l_malloc (m, sizeof (Long), cc) ;
R1p = (Long *) cholmod_l_calloc (n1rows+1, sizeof (Long), cc) ;
if (cc->status < CHOLMOD_OK)
{
// out of memory
cholmod_l_free_sparse (&Y, cc) ;
cholmod_l_free (m, sizeof (Long), P1inv, cc) ;
cholmod_l_free (n1rows+1, sizeof (Long), R1p, cc) ;
cholmod_l_free (m, sizeof (char), Mark, cc) ;
cholmod_l_free (n, sizeof (Long), Qrows, cc) ;
return (FALSE) ;
}
Yp = (Long *) Y->p ;
#ifndef NDEBUG
for (i = 0 ; i < m ; i++) P1inv [i] = EMPTY ;
#endif
kk = 0 ;
for (k = 0 ; k < n1cols ; k++)
{
i = Qrows [k] ;
if (i != EMPTY)
{
// row i is the kk-th singleton row
ASSERT (Mark [i]) ;
ASSERT (P1inv [i] == EMPTY) ;
P1inv [i] = kk ;
kk++ ;
}
}
for (i = 0 ; i < m ; i++)
{
if (!Mark [i])
{
// row i is not a singleton row
ASSERT (P1inv [i] == EMPTY) ;
P1inv [i] = kk ;
kk++ ;
}
}
ASSERT (kk == m) ;
// ---------------------------------------------------------------------
// find row counts for R11
// ---------------------------------------------------------------------
for (k = 0 ; k < n1cols ; k++)
{
for (p = Ap [k] ; p < Ap [k+1] ; p++)
{
iold = Ai [p] ;
inew = P1inv [iold] ;
ASSERT (inew < n1rows) ;
R1p [inew]++ ; // a singleton row; in R1
}
}
// ---------------------------------------------------------------------
// find row counts for R12 and column pointers for A2 part of Y
// ---------------------------------------------------------------------
ynz = 0 ;
for ( ; k < n ; k++)
{
Yp [k-n1cols] = ynz ;
for (p = Ap [k] ; p < Ap [k+1] ; p++)
{
iold = Ai [p] ;
inew = P1inv [iold] ;
if (inew < n1rows)
{
R1p [inew]++ ; // a singleton row; in R1
}
else
{
ynz++ ; // not a singleton row; in A2
}
}
}
Yp [n-n1cols] = ynz ;
#ifndef NDEBUG
PR (("n1cols: %ld\n", n1cols)) ;
for (i = 0 ; i < n1rows ; i++)
{
PR (("R1p [%ld] is %ld\n", i, R1p [i])) ;
ASSERT (R1p [i] > 0) ;
}
#endif
}
// -------------------------------------------------------------------------
// free workspace and return results
// -------------------------------------------------------------------------
cholmod_l_free (n, sizeof (Long), Qrows, cc) ;
cholmod_l_free (m, sizeof (char), Mark, cc) ;
*p_R1p = R1p ;
*p_P1inv = P1inv ;
*p_Y = Y ;
*p_n1cols = n1cols ;
*p_n1rows = n1rows ;
return (TRUE) ;
}
void mexFunction
(
int nargout,
mxArray *pargout [ ],
int nargin,
const mxArray *pargin [ ]
)
{
double dummy = 0, *px ;
cholmod_sparse Amatrix, *A, *Lsparse, *R ;
cholmod_factor *L ;
cholmod_common Common, *cm ;
Long n, minor ;
/* ---------------------------------------------------------------------- */
/* start CHOLMOD and set parameters */
/* ---------------------------------------------------------------------- */
cm = &Common ;
cholmod_l_start (cm) ;
sputil_config (SPUMONI, cm) ;
/* convert to packed LL' when done */
cm->final_asis = FALSE ;
cm->final_super = FALSE ;
cm->final_ll = TRUE ;
cm->final_pack = TRUE ;
cm->final_monotonic = TRUE ;
/* no need to prune entries due to relaxed supernodal amalgamation, since
* zeros are dropped with sputil_drop_zeros instead */
cm->final_resymbol = FALSE ;
cm->quick_return_if_not_posdef = (nargout < 2) ;
/* ---------------------------------------------------------------------- */
/* get inputs */
/* ---------------------------------------------------------------------- */
if (nargin != 1 || nargout > 3)
{
mexErrMsgTxt ("usage: [R,p,q] = chol2 (A)") ;
}
n = mxGetN (pargin [0]) ;
if (!mxIsSparse (pargin [0]) || n != mxGetM (pargin [0]))
{
mexErrMsgTxt ("A must be square and sparse") ;
}
/* get input sparse matrix A. Use triu(A) only */
A = sputil_get_sparse (pargin [0], &Amatrix, &dummy, 1) ;
/* use natural ordering if no q output parameter */
if (nargout < 3)
{
cm->nmethods = 1 ;
cm->method [0].ordering = CHOLMOD_NATURAL ;
cm->postorder = FALSE ;
}
/* ---------------------------------------------------------------------- */
/* analyze and factorize */
/* ---------------------------------------------------------------------- */
L = cholmod_l_analyze (A, cm) ;
cholmod_l_factorize (A, L, cm) ;
if (nargout < 2 && cm->status != CHOLMOD_OK)
{
mexErrMsgTxt ("matrix is not positive definite") ;
}
/* ---------------------------------------------------------------------- */
/* convert L to a sparse matrix */
/* ---------------------------------------------------------------------- */
/* the conversion sets L->minor back to n, so get a copy of it first */
minor = L->minor ;
Lsparse = cholmod_l_factor_to_sparse (L, cm) ;
if (Lsparse->xtype == CHOLMOD_COMPLEX)
{
/* convert Lsparse from complex to zomplex */
cholmod_l_sparse_xtype (CHOLMOD_ZOMPLEX, Lsparse, cm) ;
}
if (minor < n)
{
/* remove columns minor to n-1 from Lsparse */
sputil_trim (Lsparse, minor, cm) ;
}
/* drop zeros from Lsparse */
sputil_drop_zeros (Lsparse) ;
/* Lsparse is lower triangular; conjugate transpose to get R */
R = cholmod_l_transpose (Lsparse, 2, cm) ;
cholmod_l_free_sparse (&Lsparse, cm) ;
/* ---------------------------------------------------------------------- */
/* return results to MATLAB */
/* ---------------------------------------------------------------------- */
/* return R */
pargout [0] = sputil_put_sparse (&R, cm) ;
/* return minor (translate to MATLAB convention) */
if (nargout > 1)
{
pargout [1] = mxCreateDoubleMatrix (1, 1, mxREAL) ;
px = mxGetPr (pargout [1]) ;
px [0] = ((minor == n) ? 0 : (minor+1)) ;
}
/* return permutation */
if (nargout > 2)
{
pargout [2] = sputil_put_int (L->Perm, n, 1) ;
}
/* ---------------------------------------------------------------------- */
/* free workspace and the CHOLMOD L, except for what is copied to MATLAB */
/* ---------------------------------------------------------------------- */
cholmod_l_free_factor (&L, cm) ;
cholmod_l_finish (cm) ;
cholmod_l_print_common (" ", cm) ;
/*
if (cm->malloc_count != (3 + mxIsComplex (pargout[0]))) mexErrMsgTxt ("!") ;
*/
}
void mexFunction
(
int nargout,
mxArray *pargout [ ],
int nargin,
const mxArray *pargin [ ]
)
{
double dummy = 0 ;
Long *Parent ;
cholmod_sparse *A, Amatrix, *S ;
cholmod_common Common, *cm ;
Long n, coletree, c ;
char buf [LEN] ;
/* ---------------------------------------------------------------------- */
/* start CHOLMOD and set defaults */
/* ---------------------------------------------------------------------- */
cm = &Common ;
cholmod_l_start (cm) ;
sputil_config (SPUMONI, cm) ;
/* ---------------------------------------------------------------------- */
/* get inputs */
/* ---------------------------------------------------------------------- */
if (nargout > 2 || nargin < 1 || nargin > 2)
{
mexErrMsgTxt ("Usage: [parent post] = etree2 (A, mode)") ;
}
/* ---------------------------------------------------------------------- */
/* get input matrix A */
/* ---------------------------------------------------------------------- */
A = sputil_get_sparse_pattern (pargin [0], &Amatrix, &dummy, cm) ;
S = (A == &Amatrix) ? NULL : A ;
/* ---------------------------------------------------------------------- */
/* get A->stype, default is to use triu(A) */
/* ---------------------------------------------------------------------- */
A->stype = 1 ;
n = A->nrow ;
coletree = FALSE ;
if (nargin > 1)
{
buf [0] = '\0' ;
if (mxIsChar (pargin [1]))
{
mxGetString (pargin [1], buf, LEN) ;
}
c = buf [0] ;
if (tolower (c) == 'r')
{
/* unsymmetric case (A*A') if string starts with 'r' */
A->stype = 0 ;
}
else if (tolower (c) == 'c')
{
/* unsymmetric case (A'*A) if string starts with 'c' */
n = A->ncol ;
coletree = TRUE ;
A->stype = 0 ;
}
else if (tolower (c) == 's')
{
/* symmetric upper case (A) if string starts with 's' */
A->stype = 1 ;
}
else if (tolower (c) == 'l')
{
/* symmetric lower case (A) if string starts with 'l' */
A->stype = -1 ;
}
else
{
mexErrMsgTxt ("etree2: unrecognized mode") ;
}
}
if (A->stype && A->nrow != A->ncol)
{
mexErrMsgTxt ("etree2: A must be square") ;
}
/* ---------------------------------------------------------------------- */
/* compute the etree */
/* ---------------------------------------------------------------------- */
Parent = cholmod_l_malloc (n, sizeof (Long), cm) ;
if (A->stype == 1 || coletree)
{
/* symmetric case: find etree of A, using triu(A) */
/* column case: find column etree of A, which is etree of A'*A */
cholmod_l_etree (A, Parent, cm) ;
}
else
{
/* symmetric case: find etree of A, using tril(A) */
/* row case: find row etree of A, which is etree of A*A' */
/* R = A' */
cholmod_sparse *R ;
R = cholmod_l_transpose (A, 0, cm) ;
cholmod_l_etree (R, Parent, cm) ;
cholmod_l_free_sparse (&R, cm) ;
}
if (cm->status < CHOLMOD_OK)
{
/* out of memory or matrix invalid */
mexErrMsgTxt ("etree2 failed: matrix corrupted!") ;
}
/* ---------------------------------------------------------------------- */
/* return Parent to MATLAB */
/* ---------------------------------------------------------------------- */
pargout [0] = sputil_put_int (Parent, n, 1) ;
/* ---------------------------------------------------------------------- */
/* postorder the tree and return results to MATLAB */
/* ---------------------------------------------------------------------- */
if (nargout > 1)
{
Long *Post ;
Post = cholmod_l_malloc (n, sizeof (Long), cm) ;
if (cholmod_l_postorder (Parent, n, NULL, Post, cm) != n)
{
/* out of memory or Parent invalid */
mexErrMsgTxt ("etree2 postorder failed!") ;
}
pargout [1] = sputil_put_int (Post, n, 1) ;
cholmod_l_free (n, sizeof (Long), Post, cm) ;
}
/* ---------------------------------------------------------------------- */
/* free workspace */
/* ---------------------------------------------------------------------- */
cholmod_l_free (n, sizeof (Long), Parent, cm) ;
cholmod_l_free_sparse (&S, cm) ;
cholmod_l_finish (cm) ;
cholmod_l_print_common (" ", cm) ;
/* if (cm->malloc_count != 0) mexErrMsgTxt ("!") ; */
}
template <typename Entry> spqr_numeric <Entry> *spqr_factorize
(
// input, optionally freed on output
cholmod_sparse **Ahandle,
// inputs, not modified
Long freeA, // if TRUE, free A on output
double tol, // for rank detection
Long ntol, // apply tol only to first ntol columns
spqr_symbolic *QRsym,
// workspace and parameters
cholmod_common *cc
)
{
Long *Wi, *Qfill, *PLinv, *Cm, *Sp, *Stack_size,
*TaskFront, *TaskFrontp, *TaskStack, *Stack_maxstack ;
Entry *Sx, **Rblock, **Cblock, **Stacks ;
spqr_numeric <Entry> *QRnum ;
Long nf, m, n, anz, fchunk, maxfn, rank, maxfrank, rjsize, rank1,
maxstack,j, wtsize, stack, ns, ntasks, keepH, hisize ;
char *Rdead ;
cholmod_sparse *A ;
spqr_work <Entry> *Work ;
// -------------------------------------------------------------------------
// get inputs and contents of symbolic object
// -------------------------------------------------------------------------
if (QRsym == NULL)
{
// out of memory in caller
if (freeA)
{
// if freeA is true, A must always be freed, even on error
cholmod_l_free_sparse (Ahandle, cc) ;
}
return (NULL) ;
}
A = *Ahandle ;
nf = QRsym->nf ; // number of frontal matrices
m = QRsym->m ; // A is m-by-n
n = QRsym->n ;
anz = QRsym->anz ; // nnz (A)
keepH = QRsym->keepH ;
rjsize = QRsym->rjsize ;
Sp = QRsym->Sp ; // size m+1, row pointers for S
Qfill = QRsym->Qfill ; // fill-reducing ordering
PLinv = QRsym->PLinv ; // size m, leftmost column sort
ns = QRsym->ns ; // number of stacks
ntasks = QRsym->ntasks ; // number of tasks
// FUTURE: compute a unique maxfn for each stack. Current maxfn is OK, but
// it's a global max of the fn of all fronts, and need only be max fn of
// the fronts in any given stack.
maxfn = QRsym->maxfn ; // max # of columns in any front
ASSERT (maxfn <= n) ;
hisize = QRsym->hisize ; // # of integers in Hii, Householder vectors
TaskFrontp = QRsym->TaskFrontp ;
TaskFront = QRsym->TaskFront ;
TaskStack = QRsym->TaskStack ;
maxstack = QRsym->maxstack ;
Stack_maxstack = QRsym->Stack_maxstack ;
if (!(QRsym->do_rank_detection))
{
// disable rank detection if not accounted for in analysis
tol = -1 ;
}
// If there is one task, there is only one stack, and visa versa
ASSERT ((ns == 1) == (ntasks == 1)) ;
PR (("factorize with ns %ld ntasks %ld\n", ns, ntasks)) ;
// -------------------------------------------------------------------------
// allocate workspace
// -------------------------------------------------------------------------
cholmod_l_allocate_work (0, MAX (m,nf), 0, cc) ;
// shared Long workspace
Wi = (Long *) cc->Iwork ; // size m, aliased with the rest of Iwork
Cm = Wi ; // size nf
// Cblock is workspace shared by all threads
Cblock = (Entry **) cholmod_l_malloc (nf+1, sizeof (Entry *), cc) ;
Work = NULL ; // Work and its contents not yet allocated
fchunk = MIN (m, FCHUNK) ;
wtsize = 0 ;
// -------------------------------------------------------------------------
// create S
// -------------------------------------------------------------------------
// create numeric values of S = A(p,q) in row-form in Sx
Sx = (Entry *) cholmod_l_malloc (anz, sizeof (Entry), cc) ;
if (cc->status == CHOLMOD_OK)
{
// use Wi as workspace (Iwork (0:m-1)) [
spqr_stranspose2 (A, Qfill, Sp, PLinv, Sx, Wi) ;
// Wi no longer needed ]
}
PR (("status after creating Sx: %d\n", cc->status)) ;
// -------------------------------------------------------------------------
// input matrix A no longer needed; free it if the user doesn't need it
// -------------------------------------------------------------------------
if (freeA)
{
// this is done even if out of memory, above
cholmod_l_free_sparse (Ahandle, cc) ;
ASSERT (*Ahandle == NULL) ;
}
if (cc->status < CHOLMOD_OK)
{
// out of memory
FREE_WORK ;
return (NULL) ;
}
// -------------------------------------------------------------------------
// allocate numeric object
// -------------------------------------------------------------------------
QRnum = (spqr_numeric<Entry> *)
cholmod_l_malloc (1, sizeof (spqr_numeric<Entry>), cc) ;
if (cc->status < CHOLMOD_OK)
{
// out of memory
FREE_WORK ;
return (NULL) ;
}
Rblock = (Entry **) cholmod_l_malloc (nf, sizeof (Entry *), cc) ;
Rdead = (char *) cholmod_l_calloc (n, sizeof (char), cc) ;
// these may be revised (with ns=1) if we run out of memory
Stacks = (Entry **) cholmod_l_calloc (ns, sizeof (Entry *), cc) ;
Stack_size = (Long *) cholmod_l_calloc (ns, sizeof (Long), cc) ;
QRnum->Rblock = Rblock ;
QRnum->Rdead = Rdead ;
QRnum->Stacks = Stacks ;
QRnum->Stack_size = Stack_size ;
if (keepH)
{
// allocate permanent space for Stair, Tau, Hii for each front
QRnum->HStair= (Long *) cholmod_l_malloc (rjsize, sizeof (Long), cc) ;
QRnum->HTau = (Entry *) cholmod_l_malloc (rjsize, sizeof (Entry), cc) ;
QRnum->Hii = (Long *) cholmod_l_malloc (hisize, sizeof (Long), cc) ;
QRnum->Hm = (Long *) cholmod_l_malloc (nf, sizeof (Long), cc) ;
QRnum->Hr = (Long *) cholmod_l_malloc (nf, sizeof (Long), cc) ;
QRnum->HPinv = (Long *) cholmod_l_malloc (m, sizeof (Long), cc) ;
}
else
{
// H is not kept; this part of the numeric object is not used
QRnum->HStair = NULL ;
QRnum->HTau = NULL ;
QRnum->Hii = NULL ;
QRnum->Hm = NULL ;
QRnum->Hr = NULL ;
QRnum->HPinv = NULL ;
}
QRnum->n = n ;
QRnum->m = m ;
QRnum->nf = nf ;
QRnum->rjsize = rjsize ;
QRnum->hisize = hisize ;
QRnum->keepH = keepH ;
QRnum->maxstack = maxstack ;
QRnum->ns = ns ;
QRnum->ntasks = ntasks ;
QRnum->maxfm = EMPTY ; // max (Hm [0:nf-1]), computed only if H is kept
if (cc->status < CHOLMOD_OK)
{
// out of memory
spqr_freenum (&QRnum, cc) ;
FREE_WORK ;
return (NULL) ;
}
// -------------------------------------------------------------------------
// allocate workspace
// -------------------------------------------------------------------------
Work = get_Work <Entry> (ns, n, maxfn, keepH, fchunk, &wtsize, cc) ;
// -------------------------------------------------------------------------
// allocate and initialize each Stack
// -------------------------------------------------------------------------
if (cc->status == CHOLMOD_OK)
{
for (stack = 0 ; stack < ns ; stack++)
{
Entry *Stack ;
size_t stacksize = (ntasks == 1) ?
maxstack : Stack_maxstack [stack] ;
Stack_size [stack] = stacksize ;
Stack = (Entry *) cholmod_l_malloc (stacksize, sizeof (Entry), cc) ;
Stacks [stack] = Stack ;
Work [stack].Stack_head = Stack ;
Work [stack].Stack_top = Stack + stacksize ;
}
}
// -------------------------------------------------------------------------
// punt to sequential case and fchunk = 1 if out of memory
// -------------------------------------------------------------------------
if (cc->status < CHOLMOD_OK)
{
// PUNT: ran out of memory; try again with smaller workspace
// out of memory; free any stacks that were successfully allocated
if (Stacks != NULL)
{
for (stack = 0 ; stack < ns ; stack++)
{
size_t stacksize = (ntasks == 1) ?
maxstack : Stack_maxstack [stack] ;
cholmod_l_free (stacksize, sizeof (Entry), Stacks [stack], cc) ;
}
}
cholmod_l_free (ns, sizeof (Entry *), Stacks, cc) ;
cholmod_l_free (ns, sizeof (Long), Stack_size, cc) ;
// free the contents of Work, and the Work array itself
free_Work <Entry> (Work, ns, n, maxfn, wtsize, cc) ;
cholmod_l_free (ns, sizeof (spqr_work <Entry>), Work, cc) ;
// punt to a single stack, a single task, and fchunk of 1
ns = 1 ;
ntasks = 1 ;
fchunk = 1 ;
cc->status = CHOLMOD_OK ;
Work = get_Work <Entry> (ns, n, maxfn, keepH, fchunk, &wtsize, cc) ;
Stacks = (Entry **) cholmod_l_calloc (ns, sizeof (Entry *), cc) ;
Stack_size = (Long *) cholmod_l_calloc (ns, sizeof (Long), cc) ;
QRnum->Stacks = Stacks ;
QRnum->Stack_size = Stack_size ;
if (cc->status == CHOLMOD_OK)
{
Entry *Stack ;
Stack_size [0] = maxstack ;
Stack = (Entry *) cholmod_l_malloc (maxstack, sizeof (Entry), cc) ;
Stacks [0] = Stack ;
Work [0].Stack_head = Stack ;
Work [0].Stack_top = Stack + maxstack ;
}
}
// actual # of stacks and tasks used
QRnum->ns = ns ;
QRnum->ntasks = ntasks ;
// -------------------------------------------------------------------------
// check if everything was allocated OK
// -------------------------------------------------------------------------
if (cc->status < CHOLMOD_OK)
{
spqr_freenum (&QRnum, cc) ;
FREE_WORK ;
return (NULL) ;
}
// At this point, the factorization is guaranteed to succeed, unless
// sizeof (BLAS_INT) < sizeof (Long), in which case, you really should get
// a 64-bit BLAS.
// -------------------------------------------------------------------------
// create the Blob : everything the numeric factorization kernel needs
// -------------------------------------------------------------------------
spqr_blob <Entry> Blob ;
Blob.QRsym = QRsym ;
Blob.QRnum = QRnum ;
Blob.tol = tol ;
Blob.Work = Work ;
Blob.Cm = Cm ;
Blob.Cblock = Cblock ;
Blob.Sx = Sx ;
Blob.ntol = ntol ;
Blob.fchunk = fchunk ;
Blob.cc = cc ;
// -------------------------------------------------------------------------
// initialize the "pure" flop count (for performance testing only)
// -------------------------------------------------------------------------
cc->other1 [0] = 0 ;
// -------------------------------------------------------------------------
// numeric QR factorization
// -------------------------------------------------------------------------
if (ntasks == 1)
{
// Just one task, with or without TBB installed: don't use TBB
spqr_kernel (0, &Blob) ; // sequential case
}
else
{
#ifdef HAVE_TBB
// parallel case: TBB is installed, and there is more than one task
int nthreads = MAX (0, cc->SPQR_nthreads) ;
spqr_parallel (ntasks, nthreads, &Blob) ;
#else
// TBB not installed, but the work is still split into multiple tasks.
// do tasks 0 to ntasks-2 (skip the placeholder root task id = ntasks-1)
for (Long id = 0 ; id < ntasks-1 ; id++)
{
spqr_kernel (id, &Blob) ;
}
#endif
}
// -------------------------------------------------------------------------
// check for BLAS Long overflow
// -------------------------------------------------------------------------
if (CHECK_BLAS_INT && cc->status < CHOLMOD_OK)
{
// problem too large for the BLAS. This can only occur if, for example
// you're on a 64-bit platform (with sizeof (Long) = 8) and using a
// 32-bit BLAS (with sizeof (BLAS_INT) = 4). If sizeof (BLAS_INT) is
// equal to sizeof (Long), then CHECK_BLAS_INT is FALSE at
// compile-time, and this entire code is removed as dead code by the
// compiler.
spqr_freenum (&QRnum, cc) ;
FREE_WORK ;
return (NULL) ;
}
// -------------------------------------------------------------------------
// finalize the rank
// -------------------------------------------------------------------------
rank = 0 ;
maxfrank = 1 ;
for (stack = 0 ; stack < ns ; stack++)
{
rank += Work [stack].sumfrank ;
maxfrank = MAX (maxfrank, Work [stack].maxfrank) ;
}
QRnum->rank = rank ; // required by spqr_hpinv
QRnum->maxfrank = maxfrank ;
PR (("m %ld n %ld my QR rank %ld\n", m, n, rank)) ;
// -------------------------------------------------------------------------
// finalize norm(w) for the dead column 2-norms
// -------------------------------------------------------------------------
double wscale = 0 ;
double wssq = 1 ;
for (stack = 0 ; stack < ns ; stack++)
{
// norm_E_fro = norm (s.*sqrt(q)) ; see also LAPACK's dnrm2
double ws = Work [stack].wscale ;
double wq = Work [stack].wssq ;
if (wq != 0)
{
double wk = ws * sqrt (wq) ;
if (wscale < wk)
{
double rr = wscale / wk ;
wssq = 1 + wssq * rr * rr ;
wscale = wk ;
}
else
{
double rr = wk / wscale ;
wssq += rr * rr ;
}
}
}
QRnum->norm_E_fro = wscale * sqrt (wssq) ;
cc->SPQR_xstat [2] = QRnum->norm_E_fro ;
// -------------------------------------------------------------------------
// free all workspace, except Cblock and Work
// -------------------------------------------------------------------------
FREE_WORK_PART1 ;
// -------------------------------------------------------------------------
// shrink the Stacks to hold just R (and H, if H kept)
// -------------------------------------------------------------------------
// If shrink is <= 0, then the Stacks are not modified.
// If shrink is 1, each Stack is realloc'ed to the right size (default)
// If shrink is > 1, then each Stack is forcibly moved and shrunk.
// This option is mainly meant for testing, not production use.
// It should be left at 1 for production use.
Long any_moved = FALSE ;
int shrink = cc->SPQR_shrink ;
if (shrink > 0)
{
for (stack = 0 ; stack < ns ; stack++)
{
// stacksize is the current size of the this Stack
size_t stacksize = Stack_size [stack] ;
Entry *Stack = Stacks [stack] ;
// Work [stack].Stack_head points to the first empty slot in stack,
// so newstacksize is the size of the space in use by R and H.
size_t newstacksize = Work [stack].Stack_head - Stack ;
ASSERT (newstacksize <= stacksize) ;
// Reduce the size of this stack. Cblock [0:nf-1] is no longer
// needed for holding pointers to the C blocks of each frontal
// matrix. Reuse it to hold the reallocated stacks.
if (shrink > 1)
{
// force the block to move by malloc'ing a new one;
// this option is mainly for testing only.
Cblock [stack] = (Entry *) cholmod_l_malloc (newstacksize,
sizeof (Entry), cc) ;
if (Cblock [stack] == NULL)
{
// oops, the malloc failed; just use the old block
cc->status = CHOLMOD_OK ;
Cblock [stack] = Stack ;
// update the memory usage statistics, however
cc->memory_inuse +=
((newstacksize-stacksize) * sizeof (Entry)) ;
}
else
{
// malloc is OK; copy the block over and free the old one
memcpy (Cblock [stack], Stack, newstacksize*sizeof(Entry)) ;
cholmod_l_free (stacksize, sizeof (Entry), Stack, cc) ;
}
// the Stack has been shrunk to the new size
stacksize = newstacksize ;
}
else
{
// normal method; just realloc the block
Cblock [stack] = // pointer to the new Stack
(Entry *) cholmod_l_realloc (
newstacksize, // requested size of Stack, in # of Entries
sizeof (Entry), // size of each Entry in the Stack
Stack, // pointer to the old Stack
&stacksize, // input: old stack size; output: new size
cc) ;
}
Stack_size [stack] = stacksize ;
any_moved = any_moved || (Cblock [stack] != Stack) ;
// reducing the size of a block of memory always succeeds
ASSERT (cc->status == CHOLMOD_OK) ;
}
}
// -------------------------------------------------------------------------
// adjust the Rblock pointers if the Stacks have been moved
// -------------------------------------------------------------------------
if (any_moved)
{
// at least one Stack has moved; check all fronts and adjust them
for (Long task = 0 ; task < ntasks ; task++)
{
Long kfirst, klast ;
if (ntasks == 1)
{
// sequential case
kfirst = 0 ;
klast = nf ;
stack = 0 ;
}
else
{
kfirst = TaskFrontp [task] ;
klast = TaskFrontp [task+1] ;
stack = TaskStack [task] ;
}
ASSERT (stack >= 0 && stack < ns) ;
Entry *Old_Stack = Stacks [stack] ;
Entry *New_Stack = Cblock [stack] ;
if (New_Stack != Old_Stack)
{
for (Long kf = kfirst ; kf < klast ; kf++)
{
Long f = (ntasks == 1) ? kf : TaskFront [kf] ;
Rblock [f] = New_Stack + (Rblock [f] - Old_Stack) ;
}
}
}
// finalize the Stacks
for (stack = 0 ; stack < ns ; stack++)
{
Stacks [stack] = Cblock [stack] ;
}
}
// -------------------------------------------------------------------------
// free the rest of the workspace
// -------------------------------------------------------------------------
FREE_WORK_PART2 ;
// -------------------------------------------------------------------------
// extract the implicit row permutation for H
// -------------------------------------------------------------------------
// this must be done sequentially, when all threads are finished
if (keepH)
{
// use Wi as workspace (Iwork (0:m-1)) [
spqr_hpinv (QRsym, QRnum, Wi) ;
// Wi no longer needed ]
}
// -------------------------------------------------------------------------
// find the rank and return the result
// -------------------------------------------------------------------------
// find the rank of the first ntol columns of A
if (ntol >= n)
{
rank1 = rank ;
}
else
{
rank1 = 0 ;
for (j = 0 ; j < ntol ; j++)
{
if (!Rdead [j])
{
rank1++ ;
}
}
}
QRnum->rank1 = rank1 ;
return (QRnum) ;
}
int main (int argc, char **argv)
{
cholmod_common Common, *cc ;
cholmod_sparse *A ;
cholmod_dense *X, *B ;
int mtype ;
Long m, n ;
// start CHOLMOD
cc = &Common ;
cholmod_l_start (cc) ;
// A = mread (stdin) ; read in the sparse matrix A
A = (cholmod_sparse *) cholmod_l_read_matrix (stdin, 1, &mtype, cc) ;
if (mtype != CHOLMOD_SPARSE)
{
printf ("input matrix must be sparse\n") ;
exit (1) ;
}
// [m n] = size (A) ;
m = A->nrow ;
n = A->ncol ;
printf ("Matrix %6ld-by-%-6ld nnz: %6ld\n", m, n, cholmod_l_nnz (A, cc)) ;
// B = ones (m,1), a dense right-hand-side of the same type as A
B = cholmod_l_ones (m, 1, A->xtype, cc) ;
// X = A\B ; with default ordering and default column 2-norm tolerance
if (A->xtype == CHOLMOD_REAL)
{
// A, X, and B are all real
X = SuiteSparseQR <double>
(SPQR_ORDERING_DEFAULT, SPQR_DEFAULT_TOL, A, B, cc) ;
}
else
{
// A, X, and B are all complex
X = SuiteSparseQR < std::complex<double> >
(SPQR_ORDERING_DEFAULT, SPQR_DEFAULT_TOL, A, B, cc) ;
}
check_residual (A, X, B, cc) ;
cholmod_l_free_dense (&X, cc) ;
// -------------------------------------------------------------------------
// factorizing once then solving twice with different right-hand-sides
// -------------------------------------------------------------------------
// Just the real case. Complex case is essentially identical
if (A->xtype == CHOLMOD_REAL)
{
SuiteSparseQR_factorization <double> *QR ;
cholmod_dense *Y ;
Long i ;
double *Bx ;
// factorize once
QR = SuiteSparseQR_factorize <double>
(SPQR_ORDERING_DEFAULT, SPQR_DEFAULT_TOL, A, cc) ;
// solve Ax=b, using the same B as before
// Y = Q'*B
Y = SuiteSparseQR_qmult (SPQR_QTX, QR, B, cc) ;
// X = R\(E*Y)
X = SuiteSparseQR_solve (SPQR_RETX_EQUALS_B, QR, Y, cc) ;
// check the results
check_residual (A, X, B, cc) ;
// free X and Y
cholmod_l_free_dense (&Y, cc) ;
cholmod_l_free_dense (&X, cc) ;
// repeat with a different B
Bx = (double *) (B->x) ;
for (i = 0 ; i < m ; i++)
{
Bx [i] = i ;
}
// Y = Q'*B
Y = SuiteSparseQR_qmult (SPQR_QTX, QR, B, cc) ;
// X = R\(E*Y)
X = SuiteSparseQR_solve (SPQR_RETX_EQUALS_B, QR, Y, cc) ;
// check the results
check_residual (A, X, B, cc) ;
// free X and Y
cholmod_l_free_dense (&Y, cc) ;
cholmod_l_free_dense (&X, cc) ;
// free QR
SuiteSparseQR_free (&QR, cc) ;
}
// -------------------------------------------------------------------------
// free everything that remains
// -------------------------------------------------------------------------
cholmod_l_free_sparse (&A, cc) ;
cholmod_l_free_dense (&B, cc) ;
cholmod_l_finish (cc) ;
return (0) ;
}
int main (int argc, char **argv)
{
cholmod_sparse *A, *R ;
cholmod_dense *B, *C ;
SuiteSparse_long *E ;
int mtype ;
long m, n, rnk ;
size_t total_mem, available_mem ;
double t ;
// start CHOLMOD
cholmod_common *cc, Common ;
cc = &Common ;
cholmod_l_start (cc) ;
// warmup the GPU. This can take some time, but only needs
// to be done once
cc->useGPU = false ;
t = SuiteSparse_time ( ) ;
cholmod_l_gpu_memorysize (&total_mem, &available_mem, cc) ;
cc->gpuMemorySize = available_mem ;
t = SuiteSparse_time ( ) - t ;
if (cc->gpuMemorySize <= 1)
{
printf ("no GPU available\n") ;
}
printf ("available GPU memory: %g MB, warmup time: %g\n",
(double) (cc->gpuMemorySize) / (1024 * 1024), t) ;
// A = mread (stdin) ; read in the sparse matrix A
const char *filename = argv[1];
FILE *file = fopen(filename, "r");
A = (cholmod_sparse *) cholmod_l_read_matrix (file, 1, &mtype, cc) ;
fclose(file);
if (mtype != CHOLMOD_SPARSE)
{
printf ("input matrix must be sparse\n") ;
exit (1) ;
}
// [m n] = size (A) ;
m = A->nrow ;
n = A->ncol ;
long ordering = (argc < 3 ? SPQR_ORDERING_DEFAULT : atoi(argv[2]));
printf ("Matrix %6ld-by-%-6ld nnz: %6ld\n",
m, n, cholmod_l_nnz (A, cc)) ;
// B = ones (m,1), a dense right-hand-side of the same type as A
B = cholmod_l_ones (m, 1, A->xtype, cc) ;
double tol = SPQR_NO_TOL ;
long econ = 0 ;
// [Q,R,E] = qr (A), but discard Q
// SuiteSparseQR <double> (ordering, tol, econ, A, &R, &E, cc) ;
// [C,R,E] = qr (A,b), but discard Q
SuiteSparseQR <double> (ordering, tol, econ, A, B, &C, &R, &E, cc) ;
// now R'*R-A(:,E)'*A(:,E) should be epsilon
// and C = Q'*b. The solution to the least-squares problem
// should be x=R\C.
// write out R to a file
FILE *f = fopen ("R.mtx", "w") ;
cholmod_l_write_sparse (f, R, NULL, NULL, cc) ;
fclose (f) ;
// write out C to a file
f = fopen ("C.mtx", "w") ;
cholmod_l_write_dense (f, C, NULL, cc) ;
fclose (f) ;
// write out E to a file
f = fopen ("E.txt", "w") ;
for (long i = 0 ; i < n ; i++)
{
fprintf (f, "%ld\n", 1 + E [i]) ;
}
fclose (f) ;
// free everything
cholmod_l_free_sparse (&A, cc) ;
cholmod_l_free_sparse (&R, cc) ;
cholmod_l_free_dense (&C, cc) ;
// cholmod_l_free (&E, cc) ;
cholmod_l_finish (cc) ;
return (0) ;
}
void mexFunction
(
int nargout,
mxArray *pargout [ ],
int nargin,
const mxArray *pargin [ ]
)
{
double dummy = 0 ;
double *Lx, *Lx2, *Lz, *Lz2 ;
Long *Li, *Lp, *Lnz2, *Li2, *Lp2, *ColCount ;
cholmod_sparse *A, Amatrix, *Lsparse, *S ;
cholmod_factor *L ;
cholmod_common Common, *cm ;
Long j, s, n, lnz, is_complex ;
/* ---------------------------------------------------------------------- */
/* start CHOLMOD and set parameters */
/* ---------------------------------------------------------------------- */
cm = &Common ;
cholmod_l_start (cm) ;
sputil_config (SPUMONI, cm) ;
/* ---------------------------------------------------------------------- */
/* check inputs */
/* ---------------------------------------------------------------------- */
if (nargout > 1 || nargin != 2)
{
mexErrMsgTxt ("usage: L = resymbol (L, A)\n") ;
}
n = mxGetN (pargin [0]) ;
if (!mxIsSparse (pargin [0]) || n != mxGetM (pargin [0]))
{
mexErrMsgTxt ("resymbol: L must be sparse and square") ;
}
if (n != mxGetM (pargin [1]) || n != mxGetN (pargin [1]))
{
mexErrMsgTxt ("resymbol: A and L must have same dimensions") ;
}
/* ---------------------------------------------------------------------- */
/* get the sparse matrix A */
/* ---------------------------------------------------------------------- */
A = sputil_get_sparse_pattern (pargin [1], &Amatrix, &dummy, cm) ;
S = (A == &Amatrix) ? NULL : A ;
A->stype = -1 ;
/* A = sputil_get_sparse (pargin [1], &Amatrix, &dummy, -1) ; */
/* ---------------------------------------------------------------------- */
/* construct a copy of the input sparse matrix L */
/* ---------------------------------------------------------------------- */
/* get the MATLAB L */
Lp = (Long *) mxGetJc (pargin [0]) ;
Li = (Long *) mxGetIr (pargin [0]) ;
Lx = mxGetPr (pargin [0]) ;
Lz = mxGetPi (pargin [0]) ;
is_complex = mxIsComplex (pargin [0]) ;
/* allocate the CHOLMOD symbolic L */
L = cholmod_l_allocate_factor (n, cm) ;
L->ordering = CHOLMOD_NATURAL ;
ColCount = L->ColCount ;
for (j = 0 ; j < n ; j++)
{
ColCount [j] = Lp [j+1] - Lp [j] ;
}
/* allocate space for a CHOLMOD LDL' packed factor */
/* (LL' and LDL' are treated identically) */
cholmod_l_change_factor (is_complex ? CHOLMOD_ZOMPLEX : CHOLMOD_REAL,
FALSE, FALSE, TRUE, TRUE, L, cm) ;
/* copy MATLAB L into CHOLMOD L */
Lp2 = L->p ;
Li2 = L->i ;
Lx2 = L->x ;
Lz2 = L->z ;
Lnz2 = L->nz ;
lnz = L->nzmax ;
for (j = 0 ; j <= n ; j++)
{
Lp2 [j] = Lp [j] ;
}
for (j = 0 ; j < n ; j++)
{
Lnz2 [j] = Lp [j+1] - Lp [j] ;
}
for (s = 0 ; s < lnz ; s++)
{
Li2 [s] = Li [s] ;
}
for (s = 0 ; s < lnz ; s++)
{
Lx2 [s] = Lx [s] ;
}
if (is_complex)
{
for (s = 0 ; s < lnz ; s++)
{
Lz2 [s] = Lz [s] ;
}
}
/* ---------------------------------------------------------------------- */
/* resymbolic factorization */
/* ---------------------------------------------------------------------- */
cholmod_l_resymbol (A, NULL, 0, TRUE, L, cm) ;
/* ---------------------------------------------------------------------- */
/* copy the results back to MATLAB */
/* ---------------------------------------------------------------------- */
Lsparse = cholmod_l_factor_to_sparse (L, cm) ;
/* return L as a sparse matrix */
pargout [0] = sputil_put_sparse (&Lsparse, cm) ;
/* ---------------------------------------------------------------------- */
/* free workspace and the CHOLMOD L, except for what is copied to MATLAB */
/* ---------------------------------------------------------------------- */
cholmod_l_free_factor (&L, cm) ;
cholmod_l_free_sparse (&S, cm) ;
cholmod_l_finish (cm) ;
cholmod_l_print_common (" ", cm) ;
/*
if (cm->malloc_count != 3 + mxIsComplex (pargout[0])) mexErrMsgTxt ("!") ;
*/
}
static int free_sparse(cholmod_sparse** A, cholmod_common* c) {
return cholmod_l_free_sparse(A, c);
}
void mexFunction
(
int nargout,
mxArray *pargout [ ],
int nargin,
const mxArray *pargin [ ]
)
{
double dummy = 0 ;
double *Lx, *px ;
Int *Parent, *Post, *ColCount, *First, *Level, *Rp, *Ri, *Lp, *Li, *W ;
cholmod_sparse *A, Amatrix, *F, *Aup, *Alo, *R, *A1, *A2, *L, *S ;
cholmod_common Common, *cm ;
Int n, i, coletree, j, lnz, p, k, height, c ;
char buf [LEN] ;
/* ---------------------------------------------------------------------- */
/* start CHOLMOD and set defaults */
/* ---------------------------------------------------------------------- */
cm = &Common ;
cholmod_l_start (cm) ;
sputil_config (SPUMONI, cm) ;
/* ---------------------------------------------------------------------- */
/* get inputs */
/* ---------------------------------------------------------------------- */
if (nargout > 5 || nargin < 1 || nargin > 3)
{
mexErrMsgTxt (
"Usage: [count h parent post R] = symbfact2 (A, mode, Lmode)") ;
}
/* ---------------------------------------------------------------------- */
/* get input matrix A */
/* ---------------------------------------------------------------------- */
A = sputil_get_sparse_pattern (pargin [0], &Amatrix, &dummy, cm) ;
S = (A == &Amatrix) ? NULL : A ;
/* ---------------------------------------------------------------------- */
/* get A->stype, default is to use triu(A) */
/* ---------------------------------------------------------------------- */
A->stype = 1 ;
n = A->nrow ;
coletree = FALSE ;
if (nargin > 1)
{
buf [0] = '\0' ;
if (mxIsChar (pargin [1]))
{
mxGetString (pargin [1], buf, LEN) ;
}
c = buf [0] ;
if (tolower (c) == 'r')
{
/* unsymmetric case (A*A') if string starts with 'r' */
A->stype = 0 ;
}
else if (tolower (c) == 'c')
{
/* unsymmetric case (A'*A) if string starts with 'c' */
n = A->ncol ;
coletree = TRUE ;
A->stype = 0 ;
}
else if (tolower (c) == 's')
{
/* symmetric upper case (A) if string starts with 's' */
A->stype = 1 ;
}
else if (tolower (c) == 'l')
{
/* symmetric lower case (A) if string starts with 'l' */
A->stype = -1 ;
}
else
{
mexErrMsgTxt ("symbfact2: unrecognized mode") ;
}
}
if (A->stype && A->nrow != A->ncol)
{
mexErrMsgTxt ("symbfact2: A must be square") ;
}
/* ---------------------------------------------------------------------- */
/* compute the etree, its postorder, and the row/column counts */
/* ---------------------------------------------------------------------- */
Parent = cholmod_l_malloc (n, sizeof (Int), cm) ;
Post = cholmod_l_malloc (n, sizeof (Int), cm) ;
ColCount = cholmod_l_malloc (n, sizeof (Int), cm) ;
First = cholmod_l_malloc (n, sizeof (Int), cm) ;
Level = cholmod_l_malloc (n, sizeof (Int), cm) ;
/* F = A' */
F = cholmod_l_transpose (A, 0, cm) ;
if (A->stype == 1 || coletree)
{
/* symmetric upper case: find etree of A, using triu(A) */
/* column case: find column etree of A, which is etree of A'*A */
Aup = A ;
Alo = F ;
}
else
{
/* symmetric lower case: find etree of A, using tril(A) */
/* row case: find row etree of A, which is etree of A*A' */
Aup = F ;
Alo = A ;
}
cholmod_l_etree (Aup, Parent, cm) ;
if (cm->status < CHOLMOD_OK)
{
/* out of memory or matrix invalid */
mexErrMsgTxt ("symbfact2 failed: matrix corrupted!") ;
}
if (cholmod_l_postorder (Parent, n, NULL, Post, cm) != n)
{
/* out of memory or Parent invalid */
mexErrMsgTxt ("symbfact2 postorder failed!") ;
}
/* symmetric upper case: analyze tril(F), which is triu(A) */
/* column case: analyze F*F', which is A'*A */
/* symmetric lower case: analyze tril(A) */
/* row case: analyze A*A' */
cholmod_l_rowcolcounts (Alo, NULL, 0, Parent, Post, NULL, ColCount,
First, Level, cm) ;
if (cm->status < CHOLMOD_OK)
{
/* out of memory or matrix invalid */
mexErrMsgTxt ("symbfact2 failed: matrix corrupted!") ;
}
/* ---------------------------------------------------------------------- */
/* return results to MATLAB: count, h, parent, and post */
/* ---------------------------------------------------------------------- */
pargout [0] = sputil_put_int (ColCount, n, 0) ;
if (nargout > 1)
{
/* compute the elimination tree height */
height = 0 ;
for (i = 0 ; i < n ; i++)
{
height = MAX (height, Level [i]) ;
}
height++ ;
pargout [1] = mxCreateDoubleMatrix (1, 1, mxREAL) ;
px = mxGetPr (pargout [1]) ;
px [0] = height ;
}
if (nargout > 2)
{
pargout [2] = sputil_put_int (Parent, n, 1) ;
}
if (nargout > 3)
{
pargout [3] = sputil_put_int (Post, n, 1) ;
}
/* ---------------------------------------------------------------------- */
/* construct L, if requested */
/* ---------------------------------------------------------------------- */
if (nargout > 4)
{
if (A->stype == 1)
{
/* symmetric upper case: use triu(A) only, A2 not needed */
A1 = A ;
A2 = NULL ;
}
else if (A->stype == -1)
{
/* symmetric lower case: use tril(A) only, A2 not needed */
A1 = F ;
A2 = NULL ;
}
else if (coletree)
{
/* column case: analyze F*F' */
A1 = F ;
A2 = A ;
}
else
{
/* row case: analyze A*A' */
A1 = A ;
A2 = F ;
}
/* count the total number of entries in L */
lnz = 0 ;
for (j = 0 ; j < n ; j++)
{
lnz += ColCount [j] ;
}
/* allocate the output matrix L (pattern-only) */
L = cholmod_l_allocate_sparse (n, n, lnz, TRUE, TRUE, 0,
CHOLMOD_PATTERN, cm) ;
Lp = L->p ;
Li = L->i ;
/* initialize column pointers */
lnz = 0 ;
for (j = 0 ; j < n ; j++)
{
Lp [j] = lnz ;
lnz += ColCount [j] ;
}
Lp [j] = lnz ;
/* create a copy of the column pointers */
W = First ;
for (j = 0 ; j < n ; j++)
{
W [j] = Lp [j] ;
}
/* get workspace for computing one row of L */
R = cholmod_l_allocate_sparse (n, 1, n, FALSE, TRUE, 0, CHOLMOD_PATTERN,
cm) ;
Rp = R->p ;
Ri = R->i ;
/* compute L one row at a time */
for (k = 0 ; k < n ; k++)
{
/* get the kth row of L and store in the columns of L */
cholmod_l_row_subtree (A1, A2, k, Parent, R, cm) ;
for (p = 0 ; p < Rp [1] ; p++)
{
Li [W [Ri [p]]++] = k ;
}
/* add the diagonal entry */
Li [W [k]++] = k ;
}
/* free workspace */
cholmod_l_free_sparse (&R, cm) ;
/* transpose L to get R, or leave as is */
if (nargin < 3)
{
/* R = L' */
R = cholmod_l_transpose (L, 0, cm) ;
cholmod_l_free_sparse (&L, cm) ;
L = R ;
}
/* fill numerical values of L with one's (only MATLAB needs this...) */
L->x = cholmod_l_malloc (lnz, sizeof (double), cm) ;
Lx = L->x ;
for (p = 0 ; p < lnz ; p++)
{
Lx [p] = 1 ;
}
L->xtype = CHOLMOD_REAL ;
/* return L (or R) to MATLAB */
pargout [4] = sputil_put_sparse (&L, cm) ;
}
/* ---------------------------------------------------------------------- */
/* free workspace */
/* ---------------------------------------------------------------------- */
cholmod_l_free (n, sizeof (Int), Parent, cm) ;
cholmod_l_free (n, sizeof (Int), Post, cm) ;
cholmod_l_free (n, sizeof (Int), ColCount, cm) ;
cholmod_l_free (n, sizeof (Int), First, cm) ;
cholmod_l_free (n, sizeof (Int), Level, cm) ;
cholmod_l_free_sparse (&F, cm) ;
cholmod_l_free_sparse (&S, cm) ;
cholmod_l_finish (cm) ;
cholmod_l_print_common (" ", cm) ;
/*
if (cm->malloc_count != ((nargout == 5) ? 3:0)) mexErrMsgTxt ("!") ;
*/
}
void mexFunction
(
int nargout,
mxArray *pargout [ ],
int nargin,
const mxArray *pargin [ ]
)
{
double dummy = 0, beta [2], *px, *C, *Ct, *C2, *fil, *Zt, *zt, done=1.0, *zz, dzero=0.0;
cholmod_sparse Amatrix, *A, *Lsparse ;
cholmod_factor *L ;
cholmod_common Common, *cm ;
Int minor, *It2, *Jt2 ;
mwIndex l, k2, h, k, i, j, ik, *I, *J, *Jt, *It, *I2, *J2, lfi, *w, *w2, *r;
mwSize nnz, nnzlow, m, n;
int nz = 0;
mwSignedIndex one=1, lfi_si;
mxArray *Am, *Bm;
char *uplo="L", *trans="N";
/* ---------------------------------------------------------------------- */
/* Only one input. We have to find first the Cholesky factorization. */
/* start CHOLMOD and set parameters */
/* ---------------------------------------------------------------------- */
if (nargin == 1) {
cm = &Common ;
cholmod_l_start (cm) ;
sputil_config (SPUMONI, cm) ;
/* convert to packed LDL' when done */
cm->final_asis = FALSE ;
cm->final_super = FALSE ;
cm->final_ll = FALSE ;
cm->final_pack = TRUE ;
cm->final_monotonic = TRUE ;
/* since numerically zero entries are NOT dropped from the symbolic
* pattern, we DO need to drop entries that result from supernodal
* amalgamation. */
cm->final_resymbol = TRUE ;
cm->quick_return_if_not_posdef = (nargout < 2) ;
}
/* This will disable the supernodal LL', which will be slow. */
/* cm->supernodal = CHOLMOD_SIMPLICIAL ; */
/* ---------------------------------------------------------------------- */
/* get inputs */
/* ---------------------------------------------------------------------- */
if (nargin > 3)
{
mexErrMsgTxt ("usage: Z = sinv(A), or Z = sinv(LD, 1)") ;
}
n = mxGetM (pargin [0]) ;
m = mxGetM (pargin [0]) ;
if (!mxIsSparse (pargin [0]))
{
mexErrMsgTxt ("A must be sparse") ;
}
if (n != mxGetN (pargin [0]))
{
mexErrMsgTxt ("A must be square") ;
}
/* Only one input. We have to find first the Cholesky factorization. */
if (nargin == 1) {
/* get sparse matrix A, use tril(A) */
A = sputil_get_sparse (pargin [0], &Amatrix, &dummy, -1) ;
A->stype = -1 ; /* use lower part of A */
beta [0] = 0 ;
beta [1] = 0 ;
/* ---------------------------------------------------------------------- */
/* analyze and factorize */
/* ---------------------------------------------------------------------- */
L = cholmod_l_analyze (A, cm) ;
cholmod_l_factorize_p (A, beta, NULL, 0, L, cm) ;
if (cm->status != CHOLMOD_OK)
{
mexErrMsgTxt ("matrix is not positive definite") ;
}
/* ---------------------------------------------------------------------- */
/* convert L to a sparse matrix */
/* ---------------------------------------------------------------------- */
Lsparse = cholmod_l_factor_to_sparse (L, cm) ;
if (Lsparse->xtype == CHOLMOD_COMPLEX)
{
mexErrMsgTxt ("matrix is complex") ;
}
/* ---------------------------------------------------------------------- */
/* Set the sparse Cholesky factorization in Matlab format */
/* ---------------------------------------------------------------------- */
/*Am = sputil_put_sparse (&Lsparse, cm) ;
I = mxGetIr(Am);
J = mxGetJc(Am);
C = mxGetPr(Am);
nnz = mxGetNzmax(Am); */
It2 = Lsparse->i;
Jt2 = Lsparse->p;
Ct = Lsparse->x;
nnz = (mwSize) Lsparse->nzmax;
Am = mxCreateSparse(m, m, nnz, mxREAL) ;
I = mxGetIr(Am);
J = mxGetJc(Am);
C = mxGetPr(Am);
for (j = 0 ; j < n+1 ; j++) J[j] = (mwIndex) Jt2[j];
for ( i = 0 ; i < nnz ; i++) {
I[i] = (mwIndex) It2[i];
C[i] = Ct[i];
}
cholmod_l_free_sparse (&Lsparse, cm) ;
/*FILE *out1 = fopen( "output1.txt", "w" );
if( out1 != NULL )
fprintf( out1, "Hello %d\n", nnz );
fclose (out1);*/
} else {
/* The cholesky factorization is given as an input. */
/* We have to copy it into workspace */
It = mxGetIr(pargin [0]);
Jt = mxGetJc(pargin [0]);
Ct = mxGetPr(pargin [0]);
nnz = mxGetNzmax(pargin [0]);
Am = mxCreateSparse(m, m, nnz, mxREAL) ;
I = mxGetIr(Am);
J = mxGetJc(Am);
C = mxGetPr(Am);
for (j = 0 ; j < n+1 ; j++) J[j] = Jt[j];
for ( i = 0 ; i < nnz ; i++) {
I[i] = It[i];
C[i] = Ct[i];
}
}
/* Evaluate the sparse inverse */
C[nnz-1] = 1.0/C[J[m-1]]; /* set the last element of sparse inverse */
fil = mxCalloc((mwSize)1,sizeof(double));
zt = mxCalloc((mwSize)1,sizeof(double));
Zt = mxCalloc((mwSize)1,sizeof(double));
zz = mxCalloc((mwSize)1,sizeof(double));
for (j=m-2;j!=-1;j--){
lfi = J[j+1]-(J[j]+1);
/* if (lfi > 0) */
if ( J[j+1] > (J[j]+1) )
{
/* printf("lfi = %u \n ", lfi);
printf("lfi*double = %u \n", (mwSize)lfi*sizeof(double));
printf("lfi*lfi*double = %u \n", (mwSize)lfi*(mwSize)lfi*sizeof(double));
printf("\n \n");
*/
fil = mxRealloc(fil,(mwSize)lfi*sizeof(double));
for (i=0;i<lfi;i++) fil[i] = C[J[j]+i+1]; /* take the j'th lower triangular column of the Cholesky */
zt = mxRealloc(zt,(mwSize)lfi*sizeof(double)); /* memory for the sparse inverse elements to be evaluated */
Zt = mxRealloc(Zt,(mwSize)lfi*(mwSize)lfi*sizeof(double)); /* memory for the needed sparse inverse elements */
/* Set the lower triangular for Zt */
k2 = 0;
for (k=J[j]+1;k<J[j+1];k++){
ik = I[k];
h = k2;
for (l=J[ik];l<=J[ik+1];l++){
if (I[l] == I[ J[j]+h+1 ]){
Zt[h+lfi*k2] = C[l];
h++;
}
}
k2++;
}
/* evaluate zt = fil*Zt */
lfi_si = (mwSignedIndex) lfi;
dsymv(uplo, &lfi_si, &done, Zt, &lfi_si, fil, &one, &dzero, zt, &one);
/* Set the evaluated sparse inverse elements, zt, into C */
k=lfi-1;
for (i = J[j+1]-1; i!=J[j] ; i--){
C[i] = -zt[k];
k--;
}
/* evaluate the j'th diagonal of sparse inverse */
dgemv(trans, &one, &lfi_si, &done, fil, &one, zt, &one, &dzero, zz, &one);
C[J[j]] = 1.0/C[J[j]] + zz[0];
}
else
{
/* evaluate the j'th diagonal of sparse inverse */
C[J[j]] = 1.0/C[J[j]];
}
}
/* Free the temporary variables */
mxFree(fil);
mxFree(zt);
mxFree(Zt);
mxFree(zz);
/* ---------------------------------------------------------------------- */
/* Permute the elements according to r(q) = 1:n */
/* Done only if the Cholesky was evaluated here */
/* ---------------------------------------------------------------------- */
if (nargin == 1) {
Bm = mxCreateSparse(m, m, nnz, mxREAL) ;
It = mxGetIr(Bm);
Jt = mxGetJc(Bm);
Ct = mxGetPr(Bm); /* Ct = C(r,r) */
r = (mwIndex *) L->Perm; /* fill reducing ordering */
w = mxCalloc(m,sizeof(mwIndex)); /* column counts of Am */
/* count entries in each column of Bm */
for (j=0; j<m; j++){
k = r ? r[j] : j ; /* column j of Bm is column k of Am */
for (l=J[j] ; l<J[j+1] ; l++){
i = I[l];
ik = r ? r[i] : i ; /* row i of Bm is row ik of Am */
w[ max(ik,k) ]++;
}
}
cumsum2(Jt, w, m);
for (j=0; j<m; j++){
k = r ? r[j] : j ; /* column j of Bm is column k of Am */
for (l=J[j] ; l<J[j+1] ; l++){
i= I[l];
ik = r ? r[i] : i ; /* row i of Bm is row ik of Am */
It [k2 = w[max(ik,k)]++ ] = min(ik,k);
Ct[k2] = C[l];
}
}
mxFree(w);
/* ---------------------------------------------------------------------- */
/* Transpose the permuted (upper triangular) matrix Bm into Am */
/* (this way we get sorted columns) */
/* ---------------------------------------------------------------------- */
w = mxCalloc(m,sizeof(mwIndex));
for (i=0 ; i<Jt[m] ; i++) w[It[i]]++; /* row counts of Bm */
cumsum2(J, w, m); /* row pointers */
for (j=0 ; j<m ; j++){
for (i=Jt[j] ; i<Jt[j+1] ; i++){
I[ l=w[ It[i] ]++ ] = j;
C[l] = Ct[i];
}
}
mxFree(w);
mxDestroyArray(Bm);
}
/* ---------------------------------------------------------------------- */
/* Fill the upper triangle of the sparse inverse */
/* ---------------------------------------------------------------------- */
w = mxCalloc(m,sizeof(mwIndex)); /* workspace */
w2 = mxCalloc(m,sizeof(mwIndex)); /* workspace */
for (k=0;k<J[m];k++) w[I[k]]++; /* row counts of the lower triangular */
for (k=0;k<m;k++) w2[k] = w[k] + J[k+1] - J[k] - 1; /* column counts of the sparse inverse */
nnz = (mwSize)2*nnz - m; /* The number of nonzeros in Z */
pargout[0] = mxCreateSparse(m,m,nnz,mxREAL); /* The sparse matrix */
It = mxGetIr(pargout[0]);
Jt = mxGetJc(pargout[0]);
Ct = mxGetPr(pargout[0]);
cumsum2(Jt, w2, m); /* column starting points */
for (j = 0 ; j < m ; j++){ /* fill the upper triangular */
for (k = J[j] ; k < J[j+1] ; k++){
It[l = w2[ I[k]]++] = j ; /* place C(i,j) as entry Ct(j,i) */
if (Ct) Ct[l] = C[k] ;
}
}
for (j = 0 ; j < m ; j++){ /* fill the lower triangular */
for (k = J[j]+1 ; k < J[j+1] ; k++){
It[l = w2[j]++] = I[k] ; /* place C(j,i) as entry Ct(j,i) */
if (Ct) Ct[l] = C[k] ;
}
}
mxFree(w2);
mxFree(w);
/* ---------------------------------------------------------------------- */
/* return to MATLAB */
/* ---------------------------------------------------------------------- */
/* ---------------------------------------------------------------------- */
/* free workspace and the CHOLMOD L, except for what is copied to MATLAB */
/* ---------------------------------------------------------------------- */
if (nargin == 1) {
cholmod_l_free_factor (&L, cm) ;
cholmod_l_finish (cm) ;
cholmod_l_print_common (" ", cm) ;
}
mxDestroyArray(Am);
}
template <typename Entry> int spqr_1colamd // TRUE if OK, FALSE otherwise
(
// inputs, not modified
int ordering, // all available, except 0:fixed and 3:given
// treated as 1:natural
double tol, // only accept singletons above tol
Long bncols, // number of columns of B
cholmod_sparse *A, // m-by-n sparse matrix
// outputs, neither allocated nor defined on input
Long **p_Q1fill, // size n+bncols, fill-reducing
// or natural ordering
Long **p_R1p, // size n1rows+1, R1p [k] = # of nonzeros in kth
// row of R1. NULL if n1cols == 0.
Long **p_P1inv, // size m, singleton row inverse permutation.
// If row i of A is the kth singleton row, then
// P1inv [i] = k. NULL if n1cols is zero.
cholmod_sparse **p_Y, // on output, only the first n-n1cols+1 entries of
// Y->p are defined (if Y is not NULL), where
// Y = [A B] or Y = [A2 B2]. If B is empty and
// there are no column singletons, Y is NULL
Long *p_n1cols, // number of column singletons found
Long *p_n1rows, // number of corresponding rows found
// workspace and parameters
cholmod_common *cc
)
{
Long *Q1fill, *Degree, *Qrows, *W, *Winv, *ATp, *ATj, *R1p, *P1inv, *Yp,
*Ap, *Ai, *Work ;
Entry *Ax ;
Long p, d, j, i, k, n1cols, n1rows, row, col, pend, n2rows, n2cols = EMPTY,
nz2, kk, p2, col2, ynz, fill_reducing_ordering, m, n, xtype, worksize ;
cholmod_sparse *AT, *Y ;
// -------------------------------------------------------------------------
// get inputs
// -------------------------------------------------------------------------
xtype = spqr_type <Entry> ( ) ;
m = A->nrow ;
n = A->ncol ;
Ap = (Long *) A->p ;
Ai = (Long *) A->i ;
Ax = (Entry *) A->x ;
// set outputs to NULL in case of early return
*p_Q1fill = NULL ;
*p_R1p = NULL ;
*p_P1inv = NULL ;
*p_Y = NULL ;
*p_n1cols = EMPTY ;
*p_n1rows = EMPTY ;
// -------------------------------------------------------------------------
// allocate result Q1fill (Y, R1p, P1inv allocated later)
// -------------------------------------------------------------------------
Q1fill = (Long *) cholmod_l_malloc (n+bncols, sizeof (Long), cc) ;
// -------------------------------------------------------------------------
// allocate workspace
// -------------------------------------------------------------------------
fill_reducing_ordering = !
((ordering == SPQR_ORDERING_FIXED) ||
(ordering == SPQR_ORDERING_GIVEN) ||
(ordering == SPQR_ORDERING_NATURAL)) ;
worksize = ((fill_reducing_ordering) ? 3:2) * n ;
Work = (Long *) cholmod_l_malloc (worksize, sizeof (Long), cc) ;
Degree = Work ; // size n
Qrows = Work + n ; // size n
Winv = Qrows ; // Winv and Qrows not needed at the same time
W = Qrows + n ; // size n if fill-reducing ordering, else size 0
if (cc->status < CHOLMOD_OK)
{
// out of memory; free everything and return
cholmod_l_free (worksize, sizeof (Long), Work, cc) ;
cholmod_l_free (n+bncols, sizeof (Long), Q1fill, cc) ;
return (FALSE) ;
}
// -------------------------------------------------------------------------
// initialze queue with empty columns, and columns with just one entry
// -------------------------------------------------------------------------
n1cols = 0 ;
n1rows = 0 ;
for (j = 0 ; j < n ; j++)
{
p = Ap [j] ;
d = Ap [j+1] - p ;
if (d == 0)
{
// j is a dead column singleton
PR (("initial dead %ld\n", j)) ;
Q1fill [n1cols] = j ;
Qrows [n1cols] = EMPTY ;
n1cols++ ;
Degree [j] = EMPTY ;
}
else if (d == 1 && spqr_abs (Ax [p], cc) > tol)
{
// j is a column singleton, live or dead
PR (("initial live %ld %ld\n", j, Ai [p])) ;
Q1fill [n1cols] = j ;
Qrows [n1cols] = Ai [p] ; // this might be a duplicate
n1cols++ ;
Degree [j] = EMPTY ;
}
else
{
// j has degree > 1, it is not (yet) a singleton
Degree [j] = d ;
}
}
// Degree [j] = EMPTY if j is in the singleton queue, or the Degree [j] > 1
// is the degree of column j otherwise
// -------------------------------------------------------------------------
// create AT = spones (A')
// -------------------------------------------------------------------------
AT = cholmod_l_transpose (A, 0, cc) ; // [
if (cc->status < CHOLMOD_OK)
{
// out of memory; free everything and return
cholmod_l_free (worksize, sizeof (Long), Work, cc) ;
cholmod_l_free (n+bncols, sizeof (Long), Q1fill, cc) ;
return (FALSE) ;
}
ATp = (Long *) AT->p ;
ATj = (Long *) AT->i ;
// -------------------------------------------------------------------------
// remove column singletons via breadth-first-search
// -------------------------------------------------------------------------
for (k = 0 ; k < n1cols ; k++)
{
// ---------------------------------------------------------------------
// get a new singleton from the queue
// ---------------------------------------------------------------------
col = Q1fill [k] ;
row = Qrows [k] ;
PR (("\n---- singleton col %ld row %ld\n", col, row)) ;
ASSERT (Degree [col] == EMPTY) ;
if (row == EMPTY || ATp [row] < 0)
{
// -----------------------------------------------------------------
// col is a dead column singleton; remove duplicate row index
// -----------------------------------------------------------------
Qrows [k] = EMPTY ;
row = EMPTY ;
PR (("dead: %ld\n", col)) ;
}
else
{
// -----------------------------------------------------------------
// col is a live col singleton; remove its row from matrix
// -----------------------------------------------------------------
n1rows++ ;
p = ATp [row] ;
ATp [row] = FLIP (p) ; // flag the singleton row
pend = UNFLIP (ATp [row+1]) ;
PR (("live: %ld row %ld\n", col, row)) ;
for ( ; p < pend ; p++)
{
// look for new column singletons after row is removed
j = ATj [p] ;
d = Degree [j] ;
if (d == EMPTY)
{
// j is already in the singleton queue
continue ;
}
ASSERT (d >= 1) ;
ASSERT2 (spqrDebug_listcount (j, Q1fill, n1cols, 0) == 0) ;
d-- ;
Degree [j] = d ;
if (d == 0)
{
// a new dead col singleton
PR (("newly dead %ld\n", j)) ;
Q1fill [n1cols] = j ;
Qrows [n1cols] = EMPTY ;
n1cols++ ;
Degree [j] = EMPTY ;
}
else if (d == 1)
{
// a new live col singleton; find its single live row
for (p2 = Ap [j] ; p2 < Ap [j+1] ; p2++)
{
i = Ai [p2] ;
if (ATp [i] >= 0 && spqr_abs (Ax [p2], cc) > tol)
{
// i might appear in Qrows [k+1:n1cols-1]
PR (("newly live %ld\n", j)) ;
ASSERT2 (spqrDebug_listcount (i,Qrows,k+1,1) == 0) ;
Q1fill [n1cols] = j ;
Qrows [n1cols] = i ;
n1cols++ ;
Degree [j] = EMPTY ;
break ;
}
}
}
}
}
// Q1fill [0:k] and Qrows [0:k] have no duplicates
ASSERT2 (spqrDebug_listcount (col, Q1fill, n1cols, 0) == 1) ;
ASSERT2 (IMPLIES (row >= 0, spqrDebug_listcount
(row, Qrows, k+1, 1) == 1)) ;
}
// -------------------------------------------------------------------------
// Degree flags the column singletons, ATp flags their rows
// -------------------------------------------------------------------------
#ifndef NDEBUG
k = 0 ;
for (j = 0 ; j < n ; j++)
{
PR (("j %ld Degree[j] %ld\n", j, Degree [j])) ;
if (Degree [j] > 0) k++ ; // j is not a column singleton
}
PR (("k %ld n %ld n1cols %ld\n", k, n, n1cols)) ;
ASSERT (k == n - n1cols) ;
for (k = 0 ; k < n1cols ; k++)
{
col = Q1fill [k] ;
ASSERT (Degree [col] <= 0) ;
}
k = 0 ;
for (i = 0 ; i < m ; i++)
{
if (ATp [i] >= 0) k++ ; // i is not a row of a col singleton
}
ASSERT (k == m - n1rows) ;
for (k = 0 ; k < n1cols ; k++)
{
row = Qrows [k] ;
ASSERT (IMPLIES (row != EMPTY, ATp [row] < 0)) ;
}
#endif
// -------------------------------------------------------------------------
// find the row ordering
// -------------------------------------------------------------------------
if (n1cols == 0)
{
// ---------------------------------------------------------------------
// no singletons in the matrix; no R1 matrix, no P1inv permutation
// ---------------------------------------------------------------------
ASSERT (n1rows == 0) ;
R1p = NULL ;
P1inv = NULL ;
}
else
{
// ---------------------------------------------------------------------
// construct the row singleton permutation
// ---------------------------------------------------------------------
// allocate result arrays R1p and P1inv
R1p = (Long *) cholmod_l_malloc (n1rows+1, sizeof (Long), cc) ;
P1inv = (Long *) cholmod_l_malloc (m, sizeof (Long), cc) ;
if (cc->status < CHOLMOD_OK)
{
// out of memory; free everything and return
cholmod_l_free_sparse (&AT, cc) ;
cholmod_l_free (worksize, sizeof (Long), Work, cc) ;
cholmod_l_free (n+bncols, sizeof (Long), Q1fill, cc) ;
cholmod_l_free (n1rows+1, sizeof (Long), R1p, cc) ;
cholmod_l_free (m, sizeof (Long), P1inv, cc) ;
return (FALSE) ;
}
#ifndef NDEBUG
for (i = 0 ; i < m ; i++) P1inv [i] = EMPTY ;
#endif
kk = 0 ;
for (k = 0 ; k < n1cols ; k++)
{
i = Qrows [k] ;
PR (("singleton col %ld row %ld\n", Q1fill [k], i)) ;
if (i != EMPTY)
{
// row i is the kk-th singleton row
ASSERT (ATp [i] < 0) ;
ASSERT (P1inv [i] == EMPTY) ;
P1inv [i] = kk ;
// also find # of entries in row kk of R1
R1p [kk] = UNFLIP (ATp [i+1]) - UNFLIP (ATp [i]) ;
kk++ ;
}
}
ASSERT (kk == n1rows) ;
for (i = 0 ; i < m ; i++)
{
if (ATp [i] >= 0)
{
// row i is not a singleton row
ASSERT (P1inv [i] == EMPTY) ;
P1inv [i] = kk ;
kk++ ;
}
}
ASSERT (kk == m) ;
}
// Qrows is no longer needed.
// -------------------------------------------------------------------------
// complete the column ordering
// -------------------------------------------------------------------------
if (!fill_reducing_ordering)
{
// ---------------------------------------------------------------------
// natural ordering
// ---------------------------------------------------------------------
if (n1cols == 0)
{
// no singletons, so natural ordering is 0:n-1 for now
for (k = 0 ; k < n ; k++)
{
Q1fill [k] = k ;
}
}
else
{
// singleton columns appear first, then non column singletons
k = n1cols ;
for (j = 0 ; j < n ; j++)
{
if (Degree [j] > 0)
{
// column j is not a column singleton
Q1fill [k++] = j ;
}
}
ASSERT (k == n) ;
}
}
else
{
// ---------------------------------------------------------------------
// fill-reducing ordering of pruned submatrix
// ---------------------------------------------------------------------
if (n1cols == 0)
{
// -----------------------------------------------------------------
// no singletons found; do fill-reducing on entire matrix
// -----------------------------------------------------------------
n2cols = n ;
n2rows = m ;
}
else
{
// -----------------------------------------------------------------
// create the pruned matrix for fill-reducing by removing singletons
// -----------------------------------------------------------------
// find the mapping of original columns to pruned columns
n2cols = 0 ;
for (j = 0 ; j < n ; j++)
{
if (Degree [j] > 0)
{
// column j is not a column singleton
W [j] = n2cols++ ;
PR (("W [%ld] = %ld\n", j, W [j])) ;
}
else
{
// column j is a column singleton
W [j] = EMPTY ;
PR (("W [%ld] = %ld (j is col singleton)\n", j, W [j])) ;
}
}
ASSERT (n2cols == n - n1cols) ;
// W is now a mapping of the original columns to the columns in the
// pruned matrix. W [col] == EMPTY if col is a column singleton.
// Otherwise col2 = W [j] is a column of the pruned matrix.
// -----------------------------------------------------------------
// delete row and column singletons from A'
// -----------------------------------------------------------------
// compact A' by removing row and column singletons
nz2 = 0 ;
n2rows = 0 ;
for (i = 0 ; i < m ; i++)
{
p = ATp [i] ;
if (p >= 0)
{
// row i is not a row of a column singleton
ATp [n2rows++] = nz2 ;
pend = UNFLIP (ATp [i+1]) ;
for (p = ATp [i] ; p < pend ; p++)
{
j = ATj [p] ;
ASSERT (W [j] >= 0 && W [j] < n-n1cols) ;
ATj [nz2++] = W [j] ;
}
}
}
ATp [n2rows] = nz2 ;
ASSERT (n2rows == m - n1rows) ;
}
// ---------------------------------------------------------------------
// fill-reducing ordering of the transpose of the pruned A' matrix
// ---------------------------------------------------------------------
PR (("n1cols %ld n1rows %ld n2cols %ld n2rows %ld\n",
n1cols, n1rows, n2cols, n2rows)) ;
ASSERT ((Long) AT->nrow == n) ;
ASSERT ((Long) AT->ncol == m) ;
AT->nrow = n2cols ;
AT->ncol = n2rows ;
// save the current CHOLMOD settings
Long save [6] ;
save [0] = cc->supernodal ;
save [1] = cc->nmethods ;
save [2] = cc->postorder ;
save [3] = cc->method [0].ordering ;
save [4] = cc->method [1].ordering ;
save [5] = cc->method [2].ordering ;
// follow the ordering with a postordering of the column etree
cc->postorder = TRUE ;
// 8:best: best of COLAMD(A), AMD(A'A), and METIS (if available)
if (ordering == SPQR_ORDERING_BEST)
{
ordering = SPQR_ORDERING_CHOLMOD ;
cc->nmethods = 2 ;
cc->method [0].ordering = CHOLMOD_COLAMD ;
cc->method [1].ordering = CHOLMOD_AMD ;
#ifndef NPARTITION
cc->nmethods = 3 ;
cc->method [2].ordering = CHOLMOD_METIS ;
#endif
}
// 9:bestamd: best of COLAMD(A) and AMD(A'A)
if (ordering == SPQR_ORDERING_BESTAMD)
{
// if METIS is not installed, this option is the same as 8:best
ordering = SPQR_ORDERING_CHOLMOD ;
cc->nmethods = 2 ;
cc->method [0].ordering = CHOLMOD_COLAMD ;
cc->method [1].ordering = CHOLMOD_AMD ;
}
#ifdef NPARTITION
if (ordering == SPQR_ORDERING_METIS)
{
// METIS not installed; use default ordering
ordering = SPQR_ORDERING_DEFAULT ;
}
#endif
if (ordering == SPQR_ORDERING_DEFAULT)
{
// Version 1.2.0: just use COLAMD
ordering = SPQR_ORDERING_COLAMD ;
#if 0
// Version 1.1.2 and earlier:
if (n2rows <= 2*n2cols)
{
// just use COLAMD; do not try AMD or METIS
ordering = SPQR_ORDERING_COLAMD ;
}
else
{
#ifndef NPARTITION
// use CHOLMOD's default ordering: try AMD and then METIS
// if AMD gives high fill-in, and take the best ordering found
ordering = SPQR_ORDERING_CHOLMOD ;
cc->nmethods = 0 ;
#else
// METIS is not installed, so just use AMD
ordering = SPQR_ORDERING_AMD ;
#endif
}
#endif
}
if (ordering == SPQR_ORDERING_AMD)
{
// use CHOLMOD's interface to AMD to order A'*A
cholmod_l_amd (AT, NULL, 0, (Long *) (Q1fill + n1cols), cc) ;
}
#ifndef NPARTITION
else if (ordering == SPQR_ORDERING_METIS)
{
// use CHOLMOD's interface to METIS to order A'*A (if installed)
cholmod_l_metis (AT, NULL, 0, TRUE,
(Long *) (Q1fill + n1cols), cc) ;
}
#endif
else if (ordering == SPQR_ORDERING_CHOLMOD)
{
// use CHOLMOD's internal ordering (defined by cc) to order AT
PR (("Using CHOLMOD, nmethods %d\n", cc->nmethods)) ;
cc->supernodal = CHOLMOD_SIMPLICIAL ;
cc->postorder = TRUE ;
cholmod_factor *Sc ;
Sc = cholmod_l_analyze_p2 (FALSE, AT, NULL, NULL, 0, cc) ;
if (Sc != NULL)
{
// copy perm from Sc->Perm [0:n2cols-1] to Q1fill (n1cols:n)
Long *Sc_perm = (Long *) Sc->Perm ;
for (k = 0 ; k < n2cols ; k++)
{
Q1fill [k + n1cols] = Sc_perm [k] ;
}
// CHOLMOD selected an ordering; determine the ordering used
switch (Sc->ordering)
{
case CHOLMOD_AMD: ordering = SPQR_ORDERING_AMD ;break;
case CHOLMOD_COLAMD: ordering = SPQR_ORDERING_COLAMD ;break;
case CHOLMOD_METIS: ordering = SPQR_ORDERING_METIS ;break;
}
}
cholmod_l_free_factor (&Sc, cc) ;
PR (("CHOLMOD used method %d : ordering: %d\n", cc->selected,
cc->method [cc->selected].ordering)) ;
}
else // SPQR_ORDERING_DEFAULT or SPQR_ORDERING_COLAMD
{
// use CHOLMOD's interface to COLAMD to order AT
ordering = SPQR_ORDERING_COLAMD ;
cholmod_l_colamd (AT, NULL, 0, TRUE,
(Long *) (Q1fill + n1cols), cc) ;
}
cc->SPQR_istat [7] = ordering ;
// restore the CHOLMOD settings
cc->supernodal = save [0] ;
cc->nmethods = save [1] ;
cc->postorder = save [2] ;
cc->method [0].ordering = save [3] ;
cc->method [1].ordering = save [4] ;
cc->method [2].ordering = save [5] ;
AT->nrow = n ;
AT->ncol = m ;
}
// -------------------------------------------------------------------------
// free AT
// -------------------------------------------------------------------------
cholmod_l_free_sparse (&AT, cc) ; // ]
// -------------------------------------------------------------------------
// check if the method succeeded
// -------------------------------------------------------------------------
if (cc->status < CHOLMOD_OK)
{
// out of memory; free everything and return
cholmod_l_free (worksize, sizeof (Long), Work, cc) ;
cholmod_l_free (n+bncols, sizeof (Long), Q1fill, cc) ;
cholmod_l_free (n1rows+1, sizeof (Long), R1p, cc) ;
cholmod_l_free (m, sizeof (Long), P1inv, cc) ;
return (FALSE) ;
}
// -------------------------------------------------------------------------
// map the fill-reducing ordering ordering back to A
// -------------------------------------------------------------------------
if (n1cols > 0 && fill_reducing_ordering)
{
// Winv is workspace of size n2cols <= n
#ifndef NDEBUG
for (j = 0 ; j < n2cols ; j++) Winv [j] = EMPTY ;
#endif
for (j = 0 ; j < n ; j++)
{
// j is a column of A. col2 = W [j] is either EMPTY, or it is
// the corresponding column of the pruned matrix
col2 = W [j] ;
if (col2 != EMPTY)
{
ASSERT (col2 >= 0 && col2 < n2cols) ;
Winv [col2] = j ;
}
}
for (k = n1cols ; k < n ; k++)
{
// col2 is a column of the pruned matrix
col2 = Q1fill [k] ;
// j is the corresonding column of the A matrix
j = Winv [col2] ;
ASSERT (j >= 0 && j < n) ;
Q1fill [k] = j ;
}
}
// -------------------------------------------------------------------------
// identity permutation of the columns of B
// -------------------------------------------------------------------------
for (k = n ; k < n+bncols ; k++)
{
// tack on the identity permutation for columns of B
Q1fill [k] = k ;
}
// -------------------------------------------------------------------------
// find column pointers for Y = [A2 B2]; columns of A2
// -------------------------------------------------------------------------
if (n1cols == 0 && bncols == 0)
{
// A will be factorized instead of Y
Y = NULL ;
}
else
{
// Y has no entries yet; nnz(Y) will be determined later
Y = cholmod_l_allocate_sparse (m-n1rows, n-n1cols+bncols, 0,
FALSE, TRUE, 0, xtype, cc) ;
if (cc->status < CHOLMOD_OK)
{
// out of memory; free everything and return
cholmod_l_free (worksize, sizeof (Long), Work, cc) ;
cholmod_l_free (n+bncols, sizeof (Long), Q1fill, cc) ;
cholmod_l_free (n1rows+1, sizeof (Long), R1p, cc) ;
cholmod_l_free (m, sizeof (Long), P1inv, cc) ;
return (FALSE) ;
}
Yp = (Long *) Y->p ;
ynz = 0 ;
PR (("1c wrapup: n1cols %ld n %ld\n", n1cols, n)) ;
for (k = n1cols ; k < n ; k++)
{
j = Q1fill [k] ;
d = Degree [j] ;
ASSERT (d >= 1 && d <= m) ;
Yp [k-n1cols] = ynz ;
ynz += d ;
}
Yp [n-n1cols] = ynz ;
}
// -------------------------------------------------------------------------
// free workspace and return results
// -------------------------------------------------------------------------
cholmod_l_free (worksize, sizeof (Long), Work, cc) ;
*p_Q1fill = Q1fill ;
*p_R1p = R1p ;
*p_P1inv = P1inv ;
*p_Y = Y ;
*p_n1cols = n1cols ;
*p_n1rows = n1rows ;
return (TRUE) ;
}
int main (int argc, char **argv)
{
cholmod_sparse *A ;
cholmod_dense *X, *B, *r, *atr ;
double anorm, xnorm, rnorm, one [2] = {1,0}, minusone [2] = {-1,0}, t ;
double zero [2] = {0,0}, atrnorm ;
int mtype ;
long m, n, rnk ;
size_t total_mem, available_mem ;
// start CHOLMOD
cholmod_common *cc, Common ;
cc = &Common ;
cholmod_l_start (cc) ;
// warmup the GPU. This can take some time, but only needs
// to be done once
cc->useGPU = true ;
t = SuiteSparse_time ( ) ;
cholmod_l_gpu_memorysize (&total_mem, &available_mem, cc) ;
cc->gpuMemorySize = available_mem ;
t = SuiteSparse_time ( ) - t ;
if (cc->gpuMemorySize <= 1)
{
printf ("no GPU available\n") ;
}
printf ("available GPU memory: %g MB, warmup time: %g\n",
(double) (cc->gpuMemorySize) / (1024 * 1024), t) ;
// A = mread (stdin) ; read in the sparse matrix A
const char *filename = (argc < 2 ? "Problems/2.mtx" : argv[1]);
FILE *file = fopen(filename, "r");
A = (cholmod_sparse *) cholmod_l_read_matrix (file, 1, &mtype, cc) ;
fclose(file);
if (mtype != CHOLMOD_SPARSE)
{
printf ("input matrix must be sparse\n") ;
exit (1) ;
}
// [m n] = size (A) ;
m = A->nrow ;
n = A->ncol ;
long ordering = (argc < 3 ? SPQR_ORDERING_DEFAULT : atoi(argv[2]));
#if 1
printf ("Matrix %6ld-by-%-6ld nnz: %6ld\n",
m, n, cholmod_l_nnz (A, cc)) ;
#endif
// anorm = norm (A,1) ;
anorm = cholmod_l_norm_sparse (A, 1, cc) ;
// B = ones (m,1), a dense right-hand-side of the same type as A
B = cholmod_l_ones (m, 1, A->xtype, cc) ;
// X = A\B ; with default ordering and default column 2-norm tolerance
if (A->xtype == CHOLMOD_REAL)
{
// A, X, and B are all real
X = SuiteSparseQR <double>(ordering, SPQR_NO_TOL, A, B, cc) ;
}
else
{
#if SUPPORTS_COMPLEX
// A, X, and B are all complex
X = SuiteSparseQR < std::complex<double> >
(SPQR_ORDERING_DEFAULT, SPQR_NO_TOL, A, B, cc) ;
#else
printf("Code doesn't support std::complex<?> types.\n");
#endif
}
// get the rank(A) estimate
rnk = cc->SPQR_istat [4] ;
// compute the residual r, and A'*r, and their norms
r = cholmod_l_copy_dense (B, cc) ; // r = B
cholmod_l_sdmult (A, 0, one, minusone, X, r, cc) ; // r = A*X-r = A*x-b
rnorm = cholmod_l_norm_dense (r, 2, cc) ; // rnorm = norm (r)
atr = cholmod_l_zeros (n, 1, CHOLMOD_REAL, cc) ; // atr = zeros (n,1)
cholmod_l_sdmult (A, 1, one, zero, r, atr, cc) ; // atr = A'*r
atrnorm = cholmod_l_norm_dense (atr, 2, cc) ; // atrnorm = norm (atr)
// xnorm = norm (X)
xnorm = cholmod_l_norm_dense (X, 2, cc) ;
// write out X to a file
FILE *f = fopen ("X.mtx", "w") ;
cholmod_l_write_dense (f, X, NULL, cc) ;
fclose (f) ;
if (m <= n && anorm > 0 && xnorm > 0)
{
// find the relative residual, except for least-squares systems
rnorm /= (anorm * xnorm) ;
}
printf ("\nnorm(Ax-b): %8.1e\n", rnorm) ;
printf ("norm(A'(Ax-b)) %8.1e rank: %ld of %ld\n",
atrnorm, rnk, (m < n) ? m:n) ;
/* Write an info file. */
FILE *info = fopen("gpu_results.txt", "w");
fprintf(info, "%ld\n", cc->SPQR_istat[7]); // ordering method
fprintf(info, "%ld\n", cc->memory_usage); // memory usage (bytes)
fprintf(info, "%30.16e\n", cc->SPQR_flopcount); // flop count
fprintf(info, "%lf\n", cc->SPQR_analyze_time); // analyze time
fprintf(info, "%lf\n", cc->SPQR_factorize_time); // factorize time
fprintf(info, "-1\n") ; // cpu memory (bytes)
fprintf(info, "-1\n") ; // gpu memory (bytes)
fprintf(info, "%32.16e\n", rnorm); // residual
fprintf(info, "%ld\n", cholmod_l_nnz (A, cc)); // nnz(A)
fprintf(info, "%ld\n", cc->SPQR_istat [0]); // nnz(R)
fprintf(info, "%ld\n", cc->SPQR_istat [2]); // # of frontal matrices
fprintf(info, "%ld\n", cc->SPQR_istat [3]); // ntasks, for now
fprintf(info, "%lf\n", cc->gpuKernelTime); // kernel time (ms)
fprintf(info, "%ld\n", cc->gpuFlops); // "actual" gpu flops
fprintf(info, "%d\n", cc->gpuNumKernelLaunches); // # of kernel launches
fprintf(info, "%32.16e\n", atrnorm) ; // norm (A'*(Ax-b))
fclose(info);
// free everything
cholmod_l_free_dense (&r, cc) ;
cholmod_l_free_dense (&atr, cc) ;
cholmod_l_free_sparse (&A, cc) ;
cholmod_l_free_dense (&X, cc) ;
cholmod_l_free_dense (&B, cc) ;
cholmod_l_finish (cc) ;
return (0) ;
}