Factor :: ~Factor( void )
{
if( L )
{
cholmod_l_free_factor( &L, 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;
}
SEXP dsCMatrix_matrix_solve(SEXP a, SEXP b)
{
CHM_FR L = internal_chm_factor(a, -1, -1, -1, 0.);
CHM_DN cx, cb = AS_CHM_DN(PROTECT(mMatrix_as_dgeMatrix(b)));
R_CheckStack();
cx = cholmod_l_solve(CHOLMOD_A, L, cb, &c);
cholmod_l_free_factor(&L, &c);
UNPROTECT(1);
return chm_dense_to_SEXP(cx, 1, 0, /*dimnames = */ R_NilValue);
}
SEXP dsCMatrix_Csparse_solve(SEXP a, SEXP b)
{
CHM_FR L = internal_chm_factor(a, -1, -1, -1, 0.);
CHM_SP cx, cb = AS_CHM_SP(b);
R_CheckStack();
cx = cholmod_l_spsolve(CHOLMOD_A, L, cb, &c);
cholmod_l_free_factor(&L, &c);
return chm_sparse_to_SEXP(cx, /*do_free*/ 1, /*uploT*/ 0,
/*Rkind*/ 0, /*diag*/ "N",
/*dimnames = */ R_NilValue);
}
void Factor :: build( Upper& A )
{
if( L )
{
cholmod_l_free_factor( &L, common );
L = NULL;
}
L = cholmod_l_analyze( *A, common );
cout << "factor" << endl;
cholmod_l_factorize( *A, L, common );
cout << "factor2" << endl;
}
/**
* Fast version of getting at the diagonal matrix D of the
* (generalized) simplicial Cholesky LDL' decomposition of a
* (sparse symmetric) dsCMatrix.
*
* @param Ap symmetric CsparseMatrix
* @param permP logical indicating if permutation is allowed
* @param resultKind an (SEXP) string indicating which kind of result
* is desired.
*
* @return SEXP containing either the vector diagonal entries of D,
* or just sum_i D[i], prod_i D[i] or sum_i log(D[i]).
*/
SEXP dsCMatrix_LDL_D(SEXP Ap, SEXP permP, SEXP resultKind)
{
CHM_FR L;
SEXP ans;
int c_pr = c.print;
c.print = 0;/* stop CHOLMOD printing; we cannot suppress it (in R), and
have error handler already */
L = internal_chm_factor(Ap, asLogical(permP),
/*LDL*/ 1, /*super*/0, /*Imult*/0.);
c.print = c_pr;
ans = PROTECT(diag_tC_ptr(L->n,
L->p,
L->x,
L->Perm,
resultKind));
cholmod_l_free_factor(&L, &c);
UNPROTECT(1);
return(ans);
}
void mexFunction
(
int nargout,
mxArray *pargout [ ],
int nargin,
const mxArray *pargin [ ]
)
{
double dummy = 0, beta [2], *px ;
cholmod_sparse Amatrix, *A, *Lsparse ;
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 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 < 1 || nargin > 2 || nargout > 3)
{
mexErrMsgTxt ("usage: [L,p,q] = ldlchol (A,beta)") ;
}
n = mxGetM (pargin [0]) ;
if (!mxIsSparse (pargin [0]))
{
mexErrMsgTxt ("A must be sparse") ;
}
if (nargin == 1 && n != mxGetN (pargin [0]))
{
mexErrMsgTxt ("A must be square") ;
}
/* get sparse matrix A, use tril(A) */
A = sputil_get_sparse (pargin [0], &Amatrix, &dummy, -1) ;
if (nargin == 1)
{
A->stype = -1 ; /* use lower part of A */
beta [0] = 0 ;
beta [1] = 0 ;
}
else
{
A->stype = 0 ; /* use all of A, factorizing A*A' */
beta [0] = mxGetScalar (pargin [1]) ;
beta [1] = 0 ;
}
/* 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_p (A, beta, NULL, 0, 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) ;
}
/* ---------------------------------------------------------------------- */
/* return results to MATLAB */
/* ---------------------------------------------------------------------- */
/* return L as a sparse matrix (it may contain numerically zero entries) */
pargout [0] = sputil_put_sparse (&Lsparse, 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 ;
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 ki;
double dummy = 0 ;
double *Lx, *Lx2 ;
Int *Li, *Lp, *Li2, *Lp2, *Lnz2, *ColCount ;
cholmod_sparse Cmatrix, *R, *Lsparse ;
cholmod_factor *L ;
cholmod_common Common, *cm ;
Int j, k, s, update, n, lnz ;
char buf [LEN] ;
/* ---------------------------------------------------------------------- */
/* start CHOLMOD and set parameters */
/* ---------------------------------------------------------------------- */
cm = &Common ;
cholmod_l_start (cm) ;
sputil_config (SPUMONI, cm) ;
/* ---------------------------------------------------------------------- */
/* check inputs */
/* ---------------------------------------------------------------------- */
if (nargout > 1 || nargin < 3 || nargin > 4)
{
mexErrMsgTxt ("Usage: L = ldlrowupdate (k, L, R, '+')") ;
}
n = mxGetN (pargin [1]) ;
k = mxGetN (pargin [2]) ;
if (!mxIsSparse (pargin [1]) || !mxIsSparse (pargin [2])
|| n != mxGetM (pargin [1]) || n != mxGetM (pargin [2])
|| mxIsComplex (pargin [1]) || mxIsComplex (pargin [2]))
{
k = mxGetM (pargin [2]);
j = mxGetM (pargin [1]);
printf("n=%d L=%d R=%d \n", n, j, k);
mexErrMsgTxt ("ldlrowupdate: R and/or L not sparse, complex, or wrong"
" dimensions") ;
}
/* ---------------------------------------------------------------------- */
/* determine if we're doing an update or downdate */
/* ---------------------------------------------------------------------- */
update = TRUE ;
if (nargin > 3 && mxIsChar (pargin [3]))
{
mxGetString (pargin [3], buf, LEN) ;
if (buf [0] == '-')
{
update = FALSE ;
}
else if (buf [0] != '+')
{
mexErrMsgTxt ("ldlrowupdate: update string must be '+' or '-'") ;
}
}
/* ---------------------------------------------------------------------- */
/* get ki: column integer of update */
/* ---------------------------------------------------------------------- */
ki = (int) *mxGetPr(pargin[0]);
ki = ki-1;
/* ---------------------------------------------------------------------- */
/* get R: sparse matrix of incoming/outgoing columns */
/* ---------------------------------------------------------------------- */
R = sputil_get_sparse (pargin [2], &Cmatrix, &dummy, 0) ;
/* ---------------------------------------------------------------------- */
/* construct a copy of the input sparse matrix L */
/* ---------------------------------------------------------------------- */
/* get the MATLAB L */
Lp = (Int *) mxGetJc (pargin [1]) ;
Li = (Int *) mxGetIr (pargin [1]) ;
Lx = mxGetPr (pargin [1]) ;
/* 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 */
cholmod_l_change_factor (CHOLMOD_REAL, FALSE, FALSE, TRUE, TRUE, L, cm) ;
/* copy MATLAB L into CHOLMOD L */
Lp2 = L->p ;
Li2 = L->i ;
Lx2 = L->x ;
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] ;
}
/* ---------------------------------------------------------------------- */
/* update/downdate the LDL' factorization */
/* ---------------------------------------------------------------------- */
/* add row */
if (update){
if (!cholmod_l_rowadd (ki, R, L, cm))
{
mexErrMsgTxt ("rowadd failed\n") ;
}
}
/* delete row */
else {
if (!cholmod_l_rowdel (ki, NULL, L, cm))
{
mexErrMsgTxt ("rowdel failed\n") ;
}
}
/* ---------------------------------------------------------------------- */
/* copy the results back to MATLAB */
/* ---------------------------------------------------------------------- */
/* change L back to packed LDL' (it may have become unpacked if the
* sparsity pattern changed). This change takes O(n) time if the pattern
* of L wasn't updated. */
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_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, 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);
}
void mexFunction
(
int nargout,
mxArray *pargout [ ],
int nargin,
const mxArray *pargin [ ]
)
{
double dummy = 0, *Px, *Xsetx ;
Long *Lp, *Lnz, *Xp, *Xi, xnz, *Perm, *Lprev, *Lnext, *Xsetp ;
cholmod_sparse *Bset, Bmatrix, *Xset ;
cholmod_dense *Bdense, *X, *Y, *E ;
cholmod_factor *L ;
cholmod_common Common, *cm ;
Long k, j, n, head, tail, xsetlen ;
int sys, kind ;
/* ---------------------------------------------------------------------- */
/* start CHOLMOD and set parameters */
/* ---------------------------------------------------------------------- */
cm = &Common ;
cholmod_l_start (cm) ;
sputil_config (SPUMONI, cm) ;
/* ---------------------------------------------------------------------- */
/* check inputs */
/* ---------------------------------------------------------------------- */
if (nargin != 5 || nargout > 2)
{
mexErrMsgTxt ("usage: [x xset] = lsubsolve (L,kind,P,b,system)") ;
}
n = mxGetN (pargin [0]) ;
if (!mxIsSparse (pargin [0]) || n != mxGetM (pargin [0]))
{
mexErrMsgTxt ("lsubsolve: L must be sparse and square") ;
}
if (mxGetNumberOfElements (pargin [1]) != 1)
{
mexErrMsgTxt ("lsubsolve: kind must be a scalar") ;
}
if (mxIsSparse (pargin [2]) ||
!(mxIsEmpty (pargin [2]) || mxGetNumberOfElements (pargin [2]) == n))
{
mexErrMsgTxt ("lsubsolve: P must be size n, or empty") ;
}
if (mxGetM (pargin [3]) != n || mxGetN (pargin [3]) != 1)
{
mexErrMsgTxt ("lsubsolve: b wrong dimension") ;
}
if (!mxIsSparse (pargin [3]))
{
mexErrMsgTxt ("lxbpattern: b must be sparse") ;
}
if (mxGetNumberOfElements (pargin [4]) != 1)
{
mexErrMsgTxt ("lsubsolve: system must be a scalar") ;
}
/* ---------------------------------------------------------------------- */
/* get the inputs */
/* ---------------------------------------------------------------------- */
kind = (int) sputil_get_integer (pargin [1], FALSE, 0) ;
sys = (int) sputil_get_integer (pargin [4], FALSE, 0) ;
/* ---------------------------------------------------------------------- */
/* get the sparse b */
/* ---------------------------------------------------------------------- */
/* get sparse matrix B (unsymmetric) */
Bset = sputil_get_sparse (pargin [3], &Bmatrix, &dummy, 0) ;
Bdense = cholmod_l_sparse_to_dense (Bset, cm) ;
Bset->x = NULL ;
Bset->z = NULL ;
Bset->xtype = CHOLMOD_PATTERN ;
/* ---------------------------------------------------------------------- */
/* construct a shallow copy of the input sparse matrix L */
/* ---------------------------------------------------------------------- */
/* the construction of the CHOLMOD takes O(n) time and memory */
/* allocate the CHOLMOD symbolic L */
L = cholmod_l_allocate_factor (n, cm) ;
L->ordering = CHOLMOD_NATURAL ;
/* get the MATLAB L */
L->p = mxGetJc (pargin [0]) ;
L->i = mxGetIr (pargin [0]) ;
L->x = mxGetPr (pargin [0]) ;
L->z = mxGetPi (pargin [0]) ;
/* allocate and initialize the rest of L */
L->nz = cholmod_l_malloc (n, sizeof (Long), cm) ;
Lp = L->p ;
Lnz = L->nz ;
for (j = 0 ; j < n ; j++)
{
Lnz [j] = Lp [j+1] - Lp [j] ;
}
/* these pointers are not accessed in cholmod_solve2 */
L->prev = cholmod_l_malloc (n+2, sizeof (Long), cm) ;
L->next = cholmod_l_malloc (n+2, sizeof (Long), cm) ;
Lprev = L->prev ;
Lnext = L->next ;
head = n+1 ;
tail = n ;
Lnext [head] = 0 ;
Lprev [head] = -1 ;
Lnext [tail] = -1 ;
Lprev [tail] = n-1 ;
for (j = 0 ; j < n ; j++)
{
Lnext [j] = j+1 ;
Lprev [j] = j-1 ;
}
Lprev [0] = head ;
L->xtype = (mxIsComplex (pargin [0])) ? CHOLMOD_ZOMPLEX : CHOLMOD_REAL ;
L->nzmax = Lp [n] ;
/* get the permutation */
if (mxIsEmpty (pargin [2]))
{
L->Perm = NULL ;
Perm = NULL ;
}
else
{
L->ordering = CHOLMOD_GIVEN ;
L->Perm = cholmod_l_malloc (n, sizeof (Long), cm) ;
Perm = L->Perm ;
Px = mxGetPr (pargin [2]) ;
for (k = 0 ; k < n ; k++)
{
Perm [k] = ((Long) Px [k]) - 1 ;
}
}
/* set the kind, LL' or LDL' */
L->is_ll = (kind == 0) ;
/*
cholmod_l_print_factor (L, "L", cm) ;
*/
/* ---------------------------------------------------------------------- */
/* solve the system */
/* ---------------------------------------------------------------------- */
X = cholmod_l_zeros (n, 1, L->xtype, cm) ;
Xset = NULL ;
Y = NULL ;
E = NULL ;
cholmod_l_solve2 (sys, L, Bdense, Bset, &X, &Xset, &Y, &E, cm) ;
cholmod_l_free_dense (&Y, cm) ;
cholmod_l_free_dense (&E, cm) ;
/* ---------------------------------------------------------------------- */
/* return result */
/* ---------------------------------------------------------------------- */
pargout [0] = sputil_put_dense (&X, cm) ;
/* fill numerical values of Xset with one's */
Xsetp = Xset->p ;
xsetlen = Xsetp [1] ;
Xset->x = cholmod_l_malloc (xsetlen, sizeof (double), cm) ;
Xsetx = Xset->x ;
for (k = 0 ; k < xsetlen ; k++)
{
Xsetx [k] = 1 ;
}
Xset->xtype = CHOLMOD_REAL ;
pargout [1] = sputil_put_sparse (&Xset, cm) ;
/* ---------------------------------------------------------------------- */
/* free workspace and the CHOLMOD L, except for what is copied to MATLAB */
/* ---------------------------------------------------------------------- */
L->p = NULL ;
L->i = NULL ;
L->x = NULL ;
L->z = NULL ;
cholmod_l_free_factor (&L, cm) ;
cholmod_l_finish (cm) ;
cholmod_l_print_common (" ", cm) ;
}
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_factor(cholmod_factor** A, cholmod_common* c) {
return cholmod_l_free_factor(A, c);
}
void mexFunction
(
int nargout,
mxArray *pargout [ ],
int nargin,
const mxArray *pargin [ ]
)
{
double dummy = 0 ;
double *Lx, *Lx2 ;
Long *Li, *Lp, *Li2, *Lp2, *Lnz2, *ColCount ;
cholmod_sparse Cmatrix, *C, *Lsparse ;
cholmod_factor *L ;
cholmod_common Common, *cm ;
Long j, k, s, rowadd, n, lnz, ok ;
/* ---------------------------------------------------------------------- */
/* start CHOLMOD and set parameters */
/* ---------------------------------------------------------------------- */
cm = &Common ;
cholmod_l_start (cm) ;
sputil_config (SPUMONI, cm) ;
/* ---------------------------------------------------------------------- */
/* check inputs */
/* ---------------------------------------------------------------------- */
if (nargout > 1 || nargin < 2 || nargin > 3)
{
mexErrMsgTxt ("Usage: LD = ldlrowmod (LD,k,C) or ldlrowmod (LD,k)") ;
}
n = mxGetN (pargin [0]) ;
k = (Long) mxGetScalar (pargin [1]) ;
k = k - 1 ; /* change from 1-based to 0-based */
if (!mxIsSparse (pargin [0])
|| n != mxGetM (pargin [0])
|| mxIsComplex (pargin [0]))
{
mexErrMsgTxt ("ldlrowmod: L must be real, square, and sparse") ;
}
/* ---------------------------------------------------------------------- */
/* determine if we're doing an rowadd or rowdel */
/* ---------------------------------------------------------------------- */
rowadd = (nargin > 2) ;
if (rowadd)
{
if (!mxIsSparse (pargin [2])
|| n != mxGetM (pargin [2])
|| 1 != mxGetN (pargin [2])
|| mxIsComplex (pargin [2]))
{
mexErrMsgTxt ("ldlrowmod: C must be a real sparse vector, "
"with the same number of rows as LD") ;
}
}
/* ---------------------------------------------------------------------- */
/* get C: sparse vector of incoming/outgoing column */
/* ---------------------------------------------------------------------- */
C = (rowadd) ? sputil_get_sparse (pargin [2], &Cmatrix, &dummy, 0) : NULL ;
/* ---------------------------------------------------------------------- */
/* 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]) ;
/* 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 */
cholmod_l_change_factor (CHOLMOD_REAL, FALSE, FALSE, TRUE, TRUE, L, cm) ;
/* copy MATLAB L into CHOLMOD L */
Lp2 = L->p ;
Li2 = L->i ;
Lx2 = L->x ;
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] ;
}
/* ---------------------------------------------------------------------- */
/* rowadd/rowdel the LDL' factorization */
/* ---------------------------------------------------------------------- */
if (rowadd)
{
ok = cholmod_l_rowadd (k, C, L, cm) ;
}
else
{
ok = cholmod_l_rowdel (k, NULL, L, cm) ;
}
if (!ok) mexErrMsgTxt ("ldlrowmod failed\n") ;
/* ---------------------------------------------------------------------- */
/* copy the results back to MATLAB */
/* ---------------------------------------------------------------------- */
/* change L back to packed LDL' (it may have become unpacked if the
* sparsity pattern changed). This change takes O(n) time if the pattern
* of L wasn't updated. */
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_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, *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 ("!") ;
*/
}
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) ;
}
void mexFunction
(
int nargout,
mxArray *pargout [ ],
int nargin,
const mxArray *pargin [ ]
)
{
double dummy = 0, rcond, *p ;
cholmod_sparse Amatrix, Bspmatrix, *A, *Bs, *Xs ;
cholmod_dense Bmatrix, *X, *B ;
cholmod_factor *L ;
cholmod_common Common, *cm ;
Int n, B_is_sparse, ordering, k, *Perm ;
/* ---------------------------------------------------------------------- */
/* start CHOLMOD and set parameters */
/* ---------------------------------------------------------------------- */
cm = &Common ;
cholmod_l_start (cm) ;
sputil_config (SPUMONI, cm) ;
/* There is no supernodal LDL'. If cm->final_ll = FALSE (the default), then
* this mexFunction will use a simplicial LDL' when flops/lnz < 40, and a
* supernodal LL' otherwise. This may give suprising results to the MATLAB
* user, so always perform an LL' factorization by setting cm->final_ll
* to TRUE. */
cm->final_ll = TRUE ;
cm->quick_return_if_not_posdef = TRUE ;
/* ---------------------------------------------------------------------- */
/* get inputs */
/* ---------------------------------------------------------------------- */
if (nargout > 2 || nargin < 2 || nargin > 3)
{
mexErrMsgTxt ("usage: [x,rcond] = cholmod2 (A,b,ordering)") ;
}
n = mxGetM (pargin [0]) ;
if (!mxIsSparse (pargin [0]) || (n != mxGetN (pargin [0])))
{
mexErrMsgTxt ("A must be square and sparse") ;
}
if (n != mxGetM (pargin [1]))
{
mexErrMsgTxt ("# of rows of A and B must match") ;
}
/* get sparse matrix A. Use triu(A) only. */
A = sputil_get_sparse (pargin [0], &Amatrix, &dummy, 1) ;
/* get sparse or dense matrix B */
B = NULL ;
Bs = NULL ;
B_is_sparse = mxIsSparse (pargin [1]) ;
if (B_is_sparse)
{
/* get sparse matrix B (unsymmetric) */
Bs = sputil_get_sparse (pargin [1], &Bspmatrix, &dummy, 0) ;
}
else
{
/* get dense matrix B */
B = sputil_get_dense (pargin [1], &Bmatrix, &dummy) ;
}
/* get the ordering option */
if (nargin < 3)
{
/* use default ordering */
ordering = -1 ;
}
else
{
/* use a non-default option */
ordering = mxGetScalar (pargin [2]) ;
}
p = NULL ;
Perm = NULL ;
if (ordering == 0)
{
/* natural ordering */
cm->nmethods = 1 ;
cm->method [0].ordering = CHOLMOD_NATURAL ;
cm->postorder = FALSE ;
}
else if (ordering == -1)
{
/* default strategy ... nothing to change */
}
else if (ordering == -2)
{
/* default strategy, but with NESDIS in place of METIS */
cm->default_nesdis = TRUE ;
}
else if (ordering == -3)
{
/* use AMD only */
cm->nmethods = 1 ;
cm->method [0].ordering = CHOLMOD_AMD ;
cm->postorder = TRUE ;
}
else if (ordering == -4)
{
/* use METIS only */
cm->nmethods = 1 ;
cm->method [0].ordering = CHOLMOD_METIS ;
cm->postorder = TRUE ;
}
else if (ordering == -5)
{
/* use NESDIS only */
cm->nmethods = 1 ;
cm->method [0].ordering = CHOLMOD_NESDIS ;
cm->postorder = TRUE ;
}
else if (ordering == -6)
{
/* natural ordering, but with etree postordering */
cm->nmethods = 1 ;
cm->method [0].ordering = CHOLMOD_NATURAL ;
cm->postorder = TRUE ;
}
else if (ordering == -7)
{
/* always try both AMD and METIS, and pick the best */
cm->nmethods = 2 ;
cm->method [0].ordering = CHOLMOD_AMD ;
cm->method [1].ordering = CHOLMOD_METIS ;
cm->postorder = TRUE ;
}
else if (ordering >= 1)
{
/* assume the 3rd argument is a user-provided permutation of 1:n */
if (mxGetNumberOfElements (pargin [2]) != n)
{
mexErrMsgTxt ("invalid input permutation") ;
}
/* copy from double to integer, and convert to 0-based */
p = mxGetPr (pargin [2]) ;
Perm = cholmod_l_malloc (n, sizeof (Int), cm) ;
for (k = 0 ; k < n ; k++)
{
Perm [k] = p [k] - 1 ;
}
/* check the permutation */
if (!cholmod_l_check_perm (Perm, n, n, cm))
{
mexErrMsgTxt ("invalid input permutation") ;
}
/* use only the given permutation */
cm->nmethods = 1 ;
cm->method [0].ordering = CHOLMOD_GIVEN ;
cm->postorder = FALSE ;
}
else
{
mexErrMsgTxt ("invalid ordering option") ;
}
/* ---------------------------------------------------------------------- */
/* analyze and factorize */
/* ---------------------------------------------------------------------- */
L = cholmod_l_analyze_p (A, Perm, NULL, 0, cm) ;
cholmod_l_free (n, sizeof (Int), Perm, cm) ;
cholmod_l_factorize (A, L, cm) ;
rcond = cholmod_l_rcond (L, cm) ;
if (rcond == 0)
{
mexWarnMsgTxt ("Matrix is indefinite or singular to working precision");
}
else if (rcond < DBL_EPSILON)
{
mexWarnMsgTxt ("Matrix is close to singular or badly scaled.") ;
mexPrintf (" Results may be inaccurate. RCOND = %g.\n", rcond) ;
}
/* ---------------------------------------------------------------------- */
/* solve and return solution to MATLAB */
/* ---------------------------------------------------------------------- */
if (B_is_sparse)
{
/* solve AX=B with sparse X and B; return sparse X to MATLAB */
Xs = cholmod_l_spsolve (CHOLMOD_A, L, Bs, cm) ;
pargout [0] = sputil_put_sparse (&Xs, cm) ;
}
else
{
/* solve AX=B with dense X and B; return dense X to MATLAB */
X = cholmod_l_solve (CHOLMOD_A, L, B, cm) ;
pargout [0] = sputil_put_dense (&X, cm) ;
}
/* return statistics, if requested */
if (nargout > 1)
{
pargout [1] = mxCreateDoubleMatrix (1, 5, mxREAL) ;
p = mxGetPr (pargout [1]) ;
p [0] = rcond ;
p [1] = L->ordering ;
p [2] = cm->lnz ;
p [3] = cm->fl ;
p [4] = cm->memory_usage / 1048576. ;
}
cholmod_l_free_factor (&L, cm) ;
cholmod_l_finish (cm) ;
cholmod_l_print_common (" ", cm) ;
/*
if (cm->malloc_count !=
(mxIsComplex (pargout [0]) + (mxIsSparse (pargout[0]) ? 3:1)))
mexErrMsgTxt ("memory leak!") ;
*/
}
