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; }
void Cholmod<I>::getR(cholmod_sparse* A, cholmod_sparse** R) { cholmod_sparse* qrJ = cholmod_l_transpose(A, 1, &_cholmod); SuiteSparseQR<double>(SPQR_ORDERING_FIXED, SPQR_NO_TOL, qrJ->ncol, 0, qrJ, NULL, NULL, NULL, NULL, R, NULL, NULL, NULL, NULL, &_cholmod); SM_ASSERT_EQ(Exception, _cholmod.status, CHOLMOD_OK, "QR factorization failed"); CholmodIndexTraits<index_t>::free_sparse(&qrJ, &_cholmod); }
bool Cholmod<I>::factorize(cholmod_sparse* A, spqr_factor* L, double tol, bool transpose) { cholmod_sparse* At = A; if (transpose) At = cholmod_l_transpose(A, 1, &_cholmod) ; SM_ASSERT_TRUE(Exception, At != NULL, "Null input"); SM_ASSERT_TRUE(Exception, L != NULL, "Null input"); _cholmod.quick_return_if_not_posdef = 1; int status = SuiteSparseQR_numeric(tol, At, L, &_cholmod); // TODO: check if those ones are the same for cholmod and spqr switch (_cholmod.status) { case CHOLMOD_NOT_INSTALLED: std::cerr << "Cholmod failure: method not installed."; break; case CHOLMOD_OUT_OF_MEMORY: std::cerr << "Cholmod failure: out of memory."; break; case CHOLMOD_TOO_LARGE: std::cerr << "Cholmod failure: integer overflow occured."; break; case CHOLMOD_INVALID: std::cerr << "Cholmod failure: invalid input."; break; case CHOLMOD_NOT_POSDEF: // TODO(sameeragarwal): These two warnings require more // sophisticated handling going forward. For now we will be // strict and treat them as failures. std::cerr << "Cholmod warning: matrix not positive definite."; break; case CHOLMOD_DSMALL: std::cerr << "Cholmod warning: D for LDL' or diag(L) or " << "LL' has tiny absolute value."; break; case CHOLMOD_OK: if (status != 0) { break; } std::cerr << "Cholmod failure: cholmod_factorize returned zero " << "but cholmod_common::status is CHOLMOD_OK."; break; default: std::cerr << "Unknown cholmod return code. "; break; } if (transpose) CholmodIndexTraits<index_t>::free_sparse(&At, &_cholmod); if (_cholmod.status == CHOLMOD_OK && status == 1) return true; else return false; }
SEXP Csparse_transpose(SEXP x, SEXP tri) { /* TODO: lgCMatrix & igC* currently go via double prec. cholmod - * since cholmod (& cs) lacks sparse 'int' matrices */ CHM_SP chx = AS_CHM_SP__(x); int Rkind = (chx->xtype != CHOLMOD_PATTERN) ? Real_kind(x) : 0; CHM_SP chxt = cholmod_l_transpose(chx, chx->xtype, &c); SEXP dn = PROTECT(duplicate(GET_SLOT(x, Matrix_DimNamesSym))), tmp; int tr = asLogical(tri); R_CheckStack(); tmp = VECTOR_ELT(dn, 0); /* swap the dimnames */ SET_VECTOR_ELT(dn, 0, VECTOR_ELT(dn, 1)); SET_VECTOR_ELT(dn, 1, tmp); UNPROTECT(1); return chm_sparse_to_SEXP(chxt, 1, /* SWAP 'uplo' for triangular */ tr ? ((*uplo_P(x) == 'U') ? -1 : 1) : 0, Rkind, tr ? diag_P(x) : "", dn); }
spqr_factor* Cholmod<I>::analyzeQR(cholmod_sparse* J) { // From the cholmod header: // // * If you know the method that is best for your matrix, set Common->nmethods // * to 1 and set Common->method [0] to the set of parameters for that method. // * If you set it to 1 and do not provide a permutation, then only AMD will // * be called. // _cholmod.nmethods = 1; // same properties apply as cholmod_factor analyze //_cholmod.method[0].ordering = CHOLMOD_AMD; //_cholmod.supernodal = CHOLMOD_AUTO; _cholmod.SPQR_nthreads = -1; // let tbb choose whats best _cholmod.SPQR_grain = 12; // +/-2* number of cores spqr_factor* factor = NULL; cholmod_sparse* qrJ = cholmod_l_transpose(J, 1, &_cholmod) ; factor = SuiteSparseQR_symbolic <double>(SPQR_ORDERING_BEST, SPQR_DEFAULT_TOL, qrJ, &_cholmod) ; CholmodIndexTraits<index_t>::free_sparse(&qrJ, &_cholmod); SM_ASSERT_EQ(Exception, _cholmod.status, CHOLMOD_OK, "The symbolic qr factorization failed."); SM_ASSERT_FALSE(Exception, factor == NULL, "SuiteSparseQR_symbolic returned a null factor"); return factor; }
/* 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_dense* Cholmod<I>::solve(cholmod_sparse* A, spqr_factor* L, cholmod_dense* b, double tol, bool norm, double normTol) { cholmod_sparse* qrJ = cholmod_l_transpose(A, 1, &_cholmod); cholmod_dense* scaling = NULL; if (norm) { scaling = CholmodIndexTraits<index_t>::allocate_dense(qrJ->ncol, 1, qrJ->ncol, CHOLMOD_REAL, &_cholmod); double* values = reinterpret_cast<double*>(scaling->x); for (size_t i = 0; i < qrJ->ncol; ++i) { const double normCol = colNorm(qrJ, i); if (normCol < normTol) values[i] = 0.0; else values[i] = 1.0 / normCol; } SM_ASSERT_TRUE(Exception, scale(scaling, CHOLMOD_COL, qrJ), "Scaling failed"); } cholmod_dense* res = NULL; if (factorize(qrJ, L, tol)) { cholmod_dense* qrY = SuiteSparseQR_qmult(SPQR_QTX, L, b, &_cholmod); res = SuiteSparseQR_solve(SPQR_RETX_EQUALS_B, L, qrY, &_cholmod); CholmodIndexTraits<index_t>::free_dense(&qrY, &_cholmod); } if (norm) { const double* svalues = reinterpret_cast<const double*>(scaling->x); double* rvalues = reinterpret_cast<double*>(res->x); for (size_t i = 0; i < qrJ->ncol; ++i) rvalues[i] = svalues[i] * rvalues[i]; CholmodIndexTraits<index_t>::free_dense(&scaling, &_cholmod); } CholmodIndexTraits<index_t>::free_sparse(&qrJ, &_cholmod); return res; }
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); }
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, *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 ; 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 ; 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 [ ] ) { #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 }
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 ("!") ; */ }