template <typename Entry> spqr_work <Entry> *get_Work ( Long ns, // number of stacks Long n, // number of columns of A Long maxfn, // largest number of columns in any front Long keepH, // if true, H is kept Long fchunk, Long *p_wtsize, // size of WTwork for each cholmod_common *cc ) { int ok = TRUE ; spqr_work <Entry> *Work ; Long wtsize ; *p_wtsize = 0 ; // wtsize = (fchunk + (keepH ? 0:1)) * maxfn ; wtsize = spqr_mult (fchunk + (keepH ? 0:1), maxfn, &ok) ; Work = (spqr_work <Entry> *) cholmod_l_malloc (ns, sizeof (spqr_work <Entry>), cc) ; if (!ok || cc->status < CHOLMOD_OK) { // out of memory or Long overflow cholmod_l_free (ns, sizeof (spqr_work <Entry>), Work, cc) ; ERROR (CHOLMOD_OUT_OF_MEMORY, "out of memory") ; return (NULL) ; } for (Long stack = 0 ; stack < ns ; stack++) { Work [stack].Fmap = (Long *) cholmod_l_malloc (n, sizeof (Long), cc) ; Work [stack].Cmap = (Long *) cholmod_l_malloc (maxfn, sizeof(Long), cc); if (keepH) { // Staircase is a permanent part of H Work [stack].Stair1 = NULL ; } else { // Staircase workspace reused for each front Work [stack].Stair1 = (Long *) cholmod_l_malloc (maxfn, sizeof (Long), cc) ; } Work [stack].WTwork = (Entry *) cholmod_l_malloc (wtsize, sizeof (Entry), cc) ; Work [stack].sumfrank = 0 ; Work [stack].maxfrank = 0 ; Work [stack].wscale = 0 ; Work [stack].wssq = 0 ; } *p_wtsize = wtsize ; return (Work) ; }
static int put_values ( Long nz, mxArray *A, double *Ax, // complex case: size 2*nz and freed on return, // real case: size nz, not freed on return. Long is_complex, cholmod_common *cc ) { Long imag_all_zero = TRUE ; if (is_complex) { // A is complex, stored in interleaved form; split it for MATLAB Long k ; double z, *Ax2, *Az2 ; mxFree (mxGetPi (A)) ; Ax2 = (double *) cholmod_l_malloc (nz, sizeof (double), cc) ; Az2 = (double *) cholmod_l_malloc (nz, sizeof (double), cc) ; for (k = 0 ; k < nz ; k++) { Ax2 [k] = Ax [2*k] ; z = Ax [2*k+1] ; if (z != 0) { imag_all_zero = FALSE ; } Az2 [k] = z ; } mxSetPr (A, Ax2) ; if (imag_all_zero) { // free the imaginary part, converting A to real cholmod_l_free (nz, sizeof (double), Az2, cc) ; Az2 = NULL ; } mxSetPi (A, Az2) ; // NOTE: the input Ax is freed cholmod_l_free (nz, sizeof (Complex), Ax, cc) ; } else { // A is real; just set Ax and return (do not free Ax) mxSetPr (A, Ax) ; } return (TRUE) ; }
double *spqr_mx_merge_if_complex ( // inputs, not modified const mxArray *A, int make_complex, // if TRUE, return value is Complex // output Long *p_nz, // number of entries in A // workspace and parameters cholmod_common *cc ) { Long nz, m, n ; double *X, *Xx, *Xz ; if (cc == NULL) return (NULL) ; m = mxGetM (A) ; n = mxGetN (A) ; Xx = mxGetPr (A) ; Xz = mxGetPi (A) ; if (mxIsSparse (A)) { Long *Ap = (Long *) mxGetJc (A) ; nz = Ap [n] ; } else { nz = m*n ; } if (make_complex) { // Note the typecast and sizeof (...) intentionally do not match X = (double *) cholmod_l_malloc (nz, sizeof (Complex), cc) ; for (Long k = 0 ; k < nz ; k++) { X [2*k ] = Xx [k] ; X [2*k+1] = Xz ? (Xz [k]) : 0 ; } } else { X = Xx ; } *p_nz = nz ; return (X) ; }
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 ; 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 [ ] ) { #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, *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) ; }
template <typename Entry> spqr_numeric <Entry> *spqr_factorize ( // input, optionally freed on output cholmod_sparse **Ahandle, // inputs, not modified Long freeA, // if TRUE, free A on output double tol, // for rank detection Long ntol, // apply tol only to first ntol columns spqr_symbolic *QRsym, // workspace and parameters cholmod_common *cc ) { Long *Wi, *Qfill, *PLinv, *Cm, *Sp, *Stack_size, *TaskFront, *TaskFrontp, *TaskStack, *Stack_maxstack ; Entry *Sx, **Rblock, **Cblock, **Stacks ; spqr_numeric <Entry> *QRnum ; Long nf, m, n, anz, fchunk, maxfn, rank, maxfrank, rjsize, rank1, maxstack,j, wtsize, stack, ns, ntasks, keepH, hisize ; char *Rdead ; cholmod_sparse *A ; spqr_work <Entry> *Work ; // ------------------------------------------------------------------------- // get inputs and contents of symbolic object // ------------------------------------------------------------------------- if (QRsym == NULL) { // out of memory in caller if (freeA) { // if freeA is true, A must always be freed, even on error cholmod_l_free_sparse (Ahandle, cc) ; } return (NULL) ; } A = *Ahandle ; nf = QRsym->nf ; // number of frontal matrices m = QRsym->m ; // A is m-by-n n = QRsym->n ; anz = QRsym->anz ; // nnz (A) keepH = QRsym->keepH ; rjsize = QRsym->rjsize ; Sp = QRsym->Sp ; // size m+1, row pointers for S Qfill = QRsym->Qfill ; // fill-reducing ordering PLinv = QRsym->PLinv ; // size m, leftmost column sort ns = QRsym->ns ; // number of stacks ntasks = QRsym->ntasks ; // number of tasks // FUTURE: compute a unique maxfn for each stack. Current maxfn is OK, but // it's a global max of the fn of all fronts, and need only be max fn of // the fronts in any given stack. maxfn = QRsym->maxfn ; // max # of columns in any front ASSERT (maxfn <= n) ; hisize = QRsym->hisize ; // # of integers in Hii, Householder vectors TaskFrontp = QRsym->TaskFrontp ; TaskFront = QRsym->TaskFront ; TaskStack = QRsym->TaskStack ; maxstack = QRsym->maxstack ; Stack_maxstack = QRsym->Stack_maxstack ; if (!(QRsym->do_rank_detection)) { // disable rank detection if not accounted for in analysis tol = -1 ; } // If there is one task, there is only one stack, and visa versa ASSERT ((ns == 1) == (ntasks == 1)) ; PR (("factorize with ns %ld ntasks %ld\n", ns, ntasks)) ; // ------------------------------------------------------------------------- // allocate workspace // ------------------------------------------------------------------------- cholmod_l_allocate_work (0, MAX (m,nf), 0, cc) ; // shared Long workspace Wi = (Long *) cc->Iwork ; // size m, aliased with the rest of Iwork Cm = Wi ; // size nf // Cblock is workspace shared by all threads Cblock = (Entry **) cholmod_l_malloc (nf+1, sizeof (Entry *), cc) ; Work = NULL ; // Work and its contents not yet allocated fchunk = MIN (m, FCHUNK) ; wtsize = 0 ; // ------------------------------------------------------------------------- // create S // ------------------------------------------------------------------------- // create numeric values of S = A(p,q) in row-form in Sx Sx = (Entry *) cholmod_l_malloc (anz, sizeof (Entry), cc) ; if (cc->status == CHOLMOD_OK) { // use Wi as workspace (Iwork (0:m-1)) [ spqr_stranspose2 (A, Qfill, Sp, PLinv, Sx, Wi) ; // Wi no longer needed ] } PR (("status after creating Sx: %d\n", cc->status)) ; // ------------------------------------------------------------------------- // input matrix A no longer needed; free it if the user doesn't need it // ------------------------------------------------------------------------- if (freeA) { // this is done even if out of memory, above cholmod_l_free_sparse (Ahandle, cc) ; ASSERT (*Ahandle == NULL) ; } if (cc->status < CHOLMOD_OK) { // out of memory FREE_WORK ; return (NULL) ; } // ------------------------------------------------------------------------- // allocate numeric object // ------------------------------------------------------------------------- QRnum = (spqr_numeric<Entry> *) cholmod_l_malloc (1, sizeof (spqr_numeric<Entry>), cc) ; if (cc->status < CHOLMOD_OK) { // out of memory FREE_WORK ; return (NULL) ; } Rblock = (Entry **) cholmod_l_malloc (nf, sizeof (Entry *), cc) ; Rdead = (char *) cholmod_l_calloc (n, sizeof (char), cc) ; // these may be revised (with ns=1) if we run out of memory Stacks = (Entry **) cholmod_l_calloc (ns, sizeof (Entry *), cc) ; Stack_size = (Long *) cholmod_l_calloc (ns, sizeof (Long), cc) ; QRnum->Rblock = Rblock ; QRnum->Rdead = Rdead ; QRnum->Stacks = Stacks ; QRnum->Stack_size = Stack_size ; if (keepH) { // allocate permanent space for Stair, Tau, Hii for each front QRnum->HStair= (Long *) cholmod_l_malloc (rjsize, sizeof (Long), cc) ; QRnum->HTau = (Entry *) cholmod_l_malloc (rjsize, sizeof (Entry), cc) ; QRnum->Hii = (Long *) cholmod_l_malloc (hisize, sizeof (Long), cc) ; QRnum->Hm = (Long *) cholmod_l_malloc (nf, sizeof (Long), cc) ; QRnum->Hr = (Long *) cholmod_l_malloc (nf, sizeof (Long), cc) ; QRnum->HPinv = (Long *) cholmod_l_malloc (m, sizeof (Long), cc) ; } else { // H is not kept; this part of the numeric object is not used QRnum->HStair = NULL ; QRnum->HTau = NULL ; QRnum->Hii = NULL ; QRnum->Hm = NULL ; QRnum->Hr = NULL ; QRnum->HPinv = NULL ; } QRnum->n = n ; QRnum->m = m ; QRnum->nf = nf ; QRnum->rjsize = rjsize ; QRnum->hisize = hisize ; QRnum->keepH = keepH ; QRnum->maxstack = maxstack ; QRnum->ns = ns ; QRnum->ntasks = ntasks ; QRnum->maxfm = EMPTY ; // max (Hm [0:nf-1]), computed only if H is kept if (cc->status < CHOLMOD_OK) { // out of memory spqr_freenum (&QRnum, cc) ; FREE_WORK ; return (NULL) ; } // ------------------------------------------------------------------------- // allocate workspace // ------------------------------------------------------------------------- Work = get_Work <Entry> (ns, n, maxfn, keepH, fchunk, &wtsize, cc) ; // ------------------------------------------------------------------------- // allocate and initialize each Stack // ------------------------------------------------------------------------- if (cc->status == CHOLMOD_OK) { for (stack = 0 ; stack < ns ; stack++) { Entry *Stack ; size_t stacksize = (ntasks == 1) ? maxstack : Stack_maxstack [stack] ; Stack_size [stack] = stacksize ; Stack = (Entry *) cholmod_l_malloc (stacksize, sizeof (Entry), cc) ; Stacks [stack] = Stack ; Work [stack].Stack_head = Stack ; Work [stack].Stack_top = Stack + stacksize ; } } // ------------------------------------------------------------------------- // punt to sequential case and fchunk = 1 if out of memory // ------------------------------------------------------------------------- if (cc->status < CHOLMOD_OK) { // PUNT: ran out of memory; try again with smaller workspace // out of memory; free any stacks that were successfully allocated if (Stacks != NULL) { for (stack = 0 ; stack < ns ; stack++) { size_t stacksize = (ntasks == 1) ? maxstack : Stack_maxstack [stack] ; cholmod_l_free (stacksize, sizeof (Entry), Stacks [stack], cc) ; } } cholmod_l_free (ns, sizeof (Entry *), Stacks, cc) ; cholmod_l_free (ns, sizeof (Long), Stack_size, cc) ; // free the contents of Work, and the Work array itself free_Work <Entry> (Work, ns, n, maxfn, wtsize, cc) ; cholmod_l_free (ns, sizeof (spqr_work <Entry>), Work, cc) ; // punt to a single stack, a single task, and fchunk of 1 ns = 1 ; ntasks = 1 ; fchunk = 1 ; cc->status = CHOLMOD_OK ; Work = get_Work <Entry> (ns, n, maxfn, keepH, fchunk, &wtsize, cc) ; Stacks = (Entry **) cholmod_l_calloc (ns, sizeof (Entry *), cc) ; Stack_size = (Long *) cholmod_l_calloc (ns, sizeof (Long), cc) ; QRnum->Stacks = Stacks ; QRnum->Stack_size = Stack_size ; if (cc->status == CHOLMOD_OK) { Entry *Stack ; Stack_size [0] = maxstack ; Stack = (Entry *) cholmod_l_malloc (maxstack, sizeof (Entry), cc) ; Stacks [0] = Stack ; Work [0].Stack_head = Stack ; Work [0].Stack_top = Stack + maxstack ; } } // actual # of stacks and tasks used QRnum->ns = ns ; QRnum->ntasks = ntasks ; // ------------------------------------------------------------------------- // check if everything was allocated OK // ------------------------------------------------------------------------- if (cc->status < CHOLMOD_OK) { spqr_freenum (&QRnum, cc) ; FREE_WORK ; return (NULL) ; } // At this point, the factorization is guaranteed to succeed, unless // sizeof (BLAS_INT) < sizeof (Long), in which case, you really should get // a 64-bit BLAS. // ------------------------------------------------------------------------- // create the Blob : everything the numeric factorization kernel needs // ------------------------------------------------------------------------- spqr_blob <Entry> Blob ; Blob.QRsym = QRsym ; Blob.QRnum = QRnum ; Blob.tol = tol ; Blob.Work = Work ; Blob.Cm = Cm ; Blob.Cblock = Cblock ; Blob.Sx = Sx ; Blob.ntol = ntol ; Blob.fchunk = fchunk ; Blob.cc = cc ; // ------------------------------------------------------------------------- // initialize the "pure" flop count (for performance testing only) // ------------------------------------------------------------------------- cc->other1 [0] = 0 ; // ------------------------------------------------------------------------- // numeric QR factorization // ------------------------------------------------------------------------- if (ntasks == 1) { // Just one task, with or without TBB installed: don't use TBB spqr_kernel (0, &Blob) ; // sequential case } else { #ifdef HAVE_TBB // parallel case: TBB is installed, and there is more than one task int nthreads = MAX (0, cc->SPQR_nthreads) ; spqr_parallel (ntasks, nthreads, &Blob) ; #else // TBB not installed, but the work is still split into multiple tasks. // do tasks 0 to ntasks-2 (skip the placeholder root task id = ntasks-1) for (Long id = 0 ; id < ntasks-1 ; id++) { spqr_kernel (id, &Blob) ; } #endif } // ------------------------------------------------------------------------- // check for BLAS Long overflow // ------------------------------------------------------------------------- if (CHECK_BLAS_INT && cc->status < CHOLMOD_OK) { // problem too large for the BLAS. This can only occur if, for example // you're on a 64-bit platform (with sizeof (Long) = 8) and using a // 32-bit BLAS (with sizeof (BLAS_INT) = 4). If sizeof (BLAS_INT) is // equal to sizeof (Long), then CHECK_BLAS_INT is FALSE at // compile-time, and this entire code is removed as dead code by the // compiler. spqr_freenum (&QRnum, cc) ; FREE_WORK ; return (NULL) ; } // ------------------------------------------------------------------------- // finalize the rank // ------------------------------------------------------------------------- rank = 0 ; maxfrank = 1 ; for (stack = 0 ; stack < ns ; stack++) { rank += Work [stack].sumfrank ; maxfrank = MAX (maxfrank, Work [stack].maxfrank) ; } QRnum->rank = rank ; // required by spqr_hpinv QRnum->maxfrank = maxfrank ; PR (("m %ld n %ld my QR rank %ld\n", m, n, rank)) ; // ------------------------------------------------------------------------- // finalize norm(w) for the dead column 2-norms // ------------------------------------------------------------------------- double wscale = 0 ; double wssq = 1 ; for (stack = 0 ; stack < ns ; stack++) { // norm_E_fro = norm (s.*sqrt(q)) ; see also LAPACK's dnrm2 double ws = Work [stack].wscale ; double wq = Work [stack].wssq ; if (wq != 0) { double wk = ws * sqrt (wq) ; if (wscale < wk) { double rr = wscale / wk ; wssq = 1 + wssq * rr * rr ; wscale = wk ; } else { double rr = wk / wscale ; wssq += rr * rr ; } } } QRnum->norm_E_fro = wscale * sqrt (wssq) ; cc->SPQR_xstat [2] = QRnum->norm_E_fro ; // ------------------------------------------------------------------------- // free all workspace, except Cblock and Work // ------------------------------------------------------------------------- FREE_WORK_PART1 ; // ------------------------------------------------------------------------- // shrink the Stacks to hold just R (and H, if H kept) // ------------------------------------------------------------------------- // If shrink is <= 0, then the Stacks are not modified. // If shrink is 1, each Stack is realloc'ed to the right size (default) // If shrink is > 1, then each Stack is forcibly moved and shrunk. // This option is mainly meant for testing, not production use. // It should be left at 1 for production use. Long any_moved = FALSE ; int shrink = cc->SPQR_shrink ; if (shrink > 0) { for (stack = 0 ; stack < ns ; stack++) { // stacksize is the current size of the this Stack size_t stacksize = Stack_size [stack] ; Entry *Stack = Stacks [stack] ; // Work [stack].Stack_head points to the first empty slot in stack, // so newstacksize is the size of the space in use by R and H. size_t newstacksize = Work [stack].Stack_head - Stack ; ASSERT (newstacksize <= stacksize) ; // Reduce the size of this stack. Cblock [0:nf-1] is no longer // needed for holding pointers to the C blocks of each frontal // matrix. Reuse it to hold the reallocated stacks. if (shrink > 1) { // force the block to move by malloc'ing a new one; // this option is mainly for testing only. Cblock [stack] = (Entry *) cholmod_l_malloc (newstacksize, sizeof (Entry), cc) ; if (Cblock [stack] == NULL) { // oops, the malloc failed; just use the old block cc->status = CHOLMOD_OK ; Cblock [stack] = Stack ; // update the memory usage statistics, however cc->memory_inuse += ((newstacksize-stacksize) * sizeof (Entry)) ; } else { // malloc is OK; copy the block over and free the old one memcpy (Cblock [stack], Stack, newstacksize*sizeof(Entry)) ; cholmod_l_free (stacksize, sizeof (Entry), Stack, cc) ; } // the Stack has been shrunk to the new size stacksize = newstacksize ; } else { // normal method; just realloc the block Cblock [stack] = // pointer to the new Stack (Entry *) cholmod_l_realloc ( newstacksize, // requested size of Stack, in # of Entries sizeof (Entry), // size of each Entry in the Stack Stack, // pointer to the old Stack &stacksize, // input: old stack size; output: new size cc) ; } Stack_size [stack] = stacksize ; any_moved = any_moved || (Cblock [stack] != Stack) ; // reducing the size of a block of memory always succeeds ASSERT (cc->status == CHOLMOD_OK) ; } } // ------------------------------------------------------------------------- // adjust the Rblock pointers if the Stacks have been moved // ------------------------------------------------------------------------- if (any_moved) { // at least one Stack has moved; check all fronts and adjust them for (Long task = 0 ; task < ntasks ; task++) { Long kfirst, klast ; if (ntasks == 1) { // sequential case kfirst = 0 ; klast = nf ; stack = 0 ; } else { kfirst = TaskFrontp [task] ; klast = TaskFrontp [task+1] ; stack = TaskStack [task] ; } ASSERT (stack >= 0 && stack < ns) ; Entry *Old_Stack = Stacks [stack] ; Entry *New_Stack = Cblock [stack] ; if (New_Stack != Old_Stack) { for (Long kf = kfirst ; kf < klast ; kf++) { Long f = (ntasks == 1) ? kf : TaskFront [kf] ; Rblock [f] = New_Stack + (Rblock [f] - Old_Stack) ; } } } // finalize the Stacks for (stack = 0 ; stack < ns ; stack++) { Stacks [stack] = Cblock [stack] ; } } // ------------------------------------------------------------------------- // free the rest of the workspace // ------------------------------------------------------------------------- FREE_WORK_PART2 ; // ------------------------------------------------------------------------- // extract the implicit row permutation for H // ------------------------------------------------------------------------- // this must be done sequentially, when all threads are finished if (keepH) { // use Wi as workspace (Iwork (0:m-1)) [ spqr_hpinv (QRsym, QRnum, Wi) ; // Wi no longer needed ] } // ------------------------------------------------------------------------- // find the rank and return the result // ------------------------------------------------------------------------- // find the rank of the first ntol columns of A if (ntol >= n) { rank1 = rank ; } else { rank1 = 0 ; for (j = 0 ; j < ntol ; j++) { if (!Rdead [j]) { rank1++ ; } } } QRnum->rank1 = rank1 ; return (QRnum) ; }
void mexFunction ( int nargout, mxArray *pargout [ ], int nargin, const mxArray *pargin [ ] ) { double dummy = 0 ; Long *Parent ; cholmod_sparse *A, Amatrix, *S ; cholmod_common Common, *cm ; Long n, coletree, c ; char buf [LEN] ; /* ---------------------------------------------------------------------- */ /* start CHOLMOD and set defaults */ /* ---------------------------------------------------------------------- */ cm = &Common ; cholmod_l_start (cm) ; sputil_config (SPUMONI, cm) ; /* ---------------------------------------------------------------------- */ /* get inputs */ /* ---------------------------------------------------------------------- */ if (nargout > 2 || nargin < 1 || nargin > 2) { mexErrMsgTxt ("Usage: [parent post] = etree2 (A, mode)") ; } /* ---------------------------------------------------------------------- */ /* get input matrix A */ /* ---------------------------------------------------------------------- */ A = sputil_get_sparse_pattern (pargin [0], &Amatrix, &dummy, cm) ; S = (A == &Amatrix) ? NULL : A ; /* ---------------------------------------------------------------------- */ /* get A->stype, default is to use triu(A) */ /* ---------------------------------------------------------------------- */ A->stype = 1 ; n = A->nrow ; coletree = FALSE ; if (nargin > 1) { buf [0] = '\0' ; if (mxIsChar (pargin [1])) { mxGetString (pargin [1], buf, LEN) ; } c = buf [0] ; if (tolower (c) == 'r') { /* unsymmetric case (A*A') if string starts with 'r' */ A->stype = 0 ; } else if (tolower (c) == 'c') { /* unsymmetric case (A'*A) if string starts with 'c' */ n = A->ncol ; coletree = TRUE ; A->stype = 0 ; } else if (tolower (c) == 's') { /* symmetric upper case (A) if string starts with 's' */ A->stype = 1 ; } else if (tolower (c) == 'l') { /* symmetric lower case (A) if string starts with 'l' */ A->stype = -1 ; } else { mexErrMsgTxt ("etree2: unrecognized mode") ; } } if (A->stype && A->nrow != A->ncol) { mexErrMsgTxt ("etree2: A must be square") ; } /* ---------------------------------------------------------------------- */ /* compute the etree */ /* ---------------------------------------------------------------------- */ Parent = cholmod_l_malloc (n, sizeof (Long), cm) ; if (A->stype == 1 || coletree) { /* symmetric case: find etree of A, using triu(A) */ /* column case: find column etree of A, which is etree of A'*A */ cholmod_l_etree (A, Parent, cm) ; } else { /* symmetric case: find etree of A, using tril(A) */ /* row case: find row etree of A, which is etree of A*A' */ /* R = A' */ cholmod_sparse *R ; R = cholmod_l_transpose (A, 0, cm) ; cholmod_l_etree (R, Parent, cm) ; cholmod_l_free_sparse (&R, cm) ; } if (cm->status < CHOLMOD_OK) { /* out of memory or matrix invalid */ mexErrMsgTxt ("etree2 failed: matrix corrupted!") ; } /* ---------------------------------------------------------------------- */ /* return Parent to MATLAB */ /* ---------------------------------------------------------------------- */ pargout [0] = sputil_put_int (Parent, n, 1) ; /* ---------------------------------------------------------------------- */ /* postorder the tree and return results to MATLAB */ /* ---------------------------------------------------------------------- */ if (nargout > 1) { Long *Post ; Post = cholmod_l_malloc (n, sizeof (Long), cm) ; if (cholmod_l_postorder (Parent, n, NULL, Post, cm) != n) { /* out of memory or Parent invalid */ mexErrMsgTxt ("etree2 postorder failed!") ; } pargout [1] = sputil_put_int (Post, n, 1) ; cholmod_l_free (n, sizeof (Long), Post, cm) ; } /* ---------------------------------------------------------------------- */ /* free workspace */ /* ---------------------------------------------------------------------- */ cholmod_l_free (n, sizeof (Long), Parent, cm) ; cholmod_l_free_sparse (&S, cm) ; cholmod_l_finish (cm) ; cholmod_l_print_common (" ", cm) ; /* if (cm->malloc_count != 0) mexErrMsgTxt ("!") ; */ }
template <typename Entry> SuiteSparseQR_factorization <Entry> *spqr_1factor ( // inputs, not modified int ordering, // all, except 3:given treated as 0:fixed double tol, // only accept singletons above tol. If tol <= -2, // then use the default tolerance Int bncols, // number of columns of B int keepH, // if TRUE, keep the Householder vectors cholmod_sparse *A, // m-by-n sparse matrix Int ldb, // if dense, the leading dimension of B Int *Bp, // size bncols+1, column pointers of B Int *Bi, // size bnz = Bp [bncols], row indices of B Entry *Bx, // size bnz, numerical values of B // workspace and parameters cholmod_common *cc ) { spqr_symbolic *QRsym ; spqr_numeric <Entry> *QRnum ; SuiteSparseQR_factorization <Entry> *QR ; Int *Yp, *Yi, *Q1fill, *R1p, *R1j, *P1inv, *Ap, *Ai ; Entry *Yx, *R1x, *Ax ; Int noY, anz, a2nz, r1nz, ynz, i, j, k, p, p2, bnz, py, n1rows, n1cols, n2, Bsparse, d, iold, inew, m, n ; cholmod_sparse *Y ; #ifdef TIMING double t0 = spqr_time ( ) ; double t1, t2 ; #endif // ------------------------------------------------------------------------- // get inputs and allocate result // ------------------------------------------------------------------------- m = A->nrow ; n = A->ncol ; Ap = (Int *) A->p ; Ai = (Int *) A->i ; Ax = (Entry *) A->x ; QR = (SuiteSparseQR_factorization <Entry> *) cholmod_l_malloc (1, sizeof (SuiteSparseQR_factorization <Entry>), cc) ; if (cc->status < CHOLMOD_OK) { // out of memory return (NULL) ; } QR->QRsym = NULL ; QR->QRnum = NULL ; QR->R1p = NULL ; QR->R1j = NULL ; QR->R1x = NULL ; QR->P1inv = NULL ; QR->Q1fill = NULL ; QR->Rmap = NULL ; QR->RmapInv = NULL ; QR->HP1inv = NULL ; QR->narows = m ; QR->nacols = n ; QR->bncols = bncols ; QR->n1rows = 0 ; QR->n1cols = 0 ; QR->r1nz = 0 ; r1nz = 0 ; // B is an optional input. It can be sparse or dense Bsparse = (Bp != NULL && Bi != NULL) ; if (Bx == NULL) { // B is not present; force bncols to be zero bncols = 0 ; } // ------------------------------------------------------------------------- // find the default tol, if requested // ------------------------------------------------------------------------- if (tol <= SPQR_DEFAULT_TOL) { tol = spqr_tol <Entry> (A, cc) ; } if (tol < 0) { // no rank detection will be performed QR->allow_tol = FALSE ; tol = EMPTY ; } else { QR->allow_tol = TRUE ; } QR->tol = tol ; // ------------------------------------------------------------------------- // find singletons and construct column pointers for the A part of Y // ------------------------------------------------------------------------- // These return R1p, P1inv, and Y; but they are all NULL if out of memory. // Note that only Y->p is allocated (Y->i and Y->x are dummy placeholders // of one Int and one Entry, each, actually). The entries of Y are // allocated later, below. if (ordering == SPQR_ORDERING_GIVEN) { ordering = SPQR_ORDERING_FIXED ; } if (ordering == SPQR_ORDERING_FIXED) { // fixed ordering: find column singletons without permuting columns Q1fill = NULL ; spqr_1fixed <Entry> (tol, bncols, A, &R1p, &P1inv, &Y, &n1cols, &n1rows, cc) ; } else { // natural or fill-reducing ordering: find column singletons with // column permutations allowed, then permute the pruned submatrix with // a fill-reducing ordering if ordering is not SPQR_ORDERING_NATURAL. spqr_1colamd <Entry> (ordering, tol, bncols, A, &Q1fill, &R1p, &P1inv, &Y, &n1cols, &n1rows, cc) ; ordering = cc->SPQR_istat [7] ; } if (cc->status < CHOLMOD_OK) { // out of memory spqr_freefac (&QR, cc) ; return (NULL) ; } QR->R1p = R1p ; QR->P1inv = P1inv ; QR->Q1fill = Q1fill ; QR->n1rows = n1rows ; QR->n1cols = n1cols ; noY = (Y == NULL) ; // A will be factorized, not Y ASSERT (noY == (n1cols == 0 && bncols == 0)) ; Yp = noY ? NULL : (Int *) Y->p ; anz = Ap [n] ; // nonzeros in A a2nz = noY ? anz : Yp [n-n1cols] ; // nonzeros in S2 n2 = n - n1cols ; // number of columns of S2 // Y is NULL, or of size (m-n1rows)-by-(n-n1cols+bncols) ASSERT (IMPLIES (Y != NULL, ((Int) Y->nrow == m-n1rows))) ; ASSERT (IMPLIES (Y != NULL, ((Int) Y->ncol == n-n1cols+bncols))) ; // Y, if allocated, has no space for any entries yet ynz = 0 ; // ------------------------------------------------------------------------- // construct the column pointers for the B or B2 part of Y // ------------------------------------------------------------------------- if (noY) { // A will be factorized instead of Y. There is no B. C or X can exist // as empty matrices with rows but no columns ASSERT (Yp == NULL) ; ASSERT (R1p == NULL) ; ASSERT (P1inv == NULL) ; ASSERT (n1rows == 0) ; ASSERT (a2nz == Ap [n]) ; ASSERT (bncols == 0) ; } else if (n1cols == 0) { // --------------------------------------------------------------------- // construct the column pointers for the B part of Y = [S B] // --------------------------------------------------------------------- ASSERT (R1p == NULL) ; ASSERT (P1inv == NULL) ; ASSERT (n1rows == 0) ; ASSERT (a2nz == Ap [n]) ; ynz = a2nz ; if (Bsparse) { // B is sparse for (k = 0 ; k < bncols ; k++) { Yp [(n-n1cols)+k] = ynz ; d = Bp [k+1] - Bp [k] ; ynz += d ; } } else { // B is dense Entry *B1 = Bx ; for (k = 0 ; k < bncols ; k++) { // count the nonzero entries in column k of B Yp [(n-n1cols)+k] = ynz ; d = 0 ; for (i = 0 ; i < m ; i++) { if (B1 [i] != (Entry) 0) { d++ ; } } B1 += ldb ; ynz += d ; } } Yp [(n-n1cols)+bncols] = ynz ; } else { // --------------------------------------------------------------------- // construct the column pointers for the B2 part of Y = [S2 B2] // --------------------------------------------------------------------- ynz = a2nz ; if (Bsparse) { // B is sparse for (k = 0 ; k < bncols ; k++) { // count the nonzero entries in column k of B2 Yp [(n-n1cols)+k] = ynz ; d = 0 ; for (p = Bp [k] ; p < Bp [k+1] ; p++) { iold = Bi [p] ; inew = P1inv [iold] ; if (inew >= n1rows) { d++ ; } } ynz += d ; } } else { // B is dense Entry *B1 = Bx ; for (k = 0 ; k < bncols ; k++) { // count the nonzero entries in column k of B2 Yp [(n-n1cols)+k] = ynz ; d = 0 ; for (iold = 0 ; iold < m ; iold++) { inew = P1inv [iold] ; if (inew >= n1rows && B1 [iold] != (Entry) 0) { d++ ; } } B1 += ldb ; ynz += d ; } } Yp [(n-n1cols)+bncols] = ynz ; } // ------------------------------------------------------------------------- // allocate the nonzeros for Y // ------------------------------------------------------------------------- if (noY) { // no singletons found, and B is empty. pass Y=A to QR factorization, // and pass in Q1fill as the "user-provided" ordering ASSERT (Yp == NULL) ; Yi = NULL ; Yx = NULL ; } else { cholmod_l_reallocate_sparse (ynz, Y, cc) ; Yi = (Int *) Y->i ; Yx = (Entry *) Y->x ; } if (cc->status < CHOLMOD_OK) { // out of memory spqr_freefac (&QR, cc) ; cholmod_l_free_sparse (&Y, cc) ; return (NULL) ; } // ------------------------------------------------------------------------- // create the pattern and values of Y and R1 // ------------------------------------------------------------------------- if (noY) { // --------------------------------------------------------------------- // R1 does not exist // --------------------------------------------------------------------- ASSERT (R1p == NULL) ; R1j = NULL ; R1x = NULL ; } else if (n1cols == 0) { // --------------------------------------------------------------------- // R1 does not exist // --------------------------------------------------------------------- ASSERT (R1p == NULL) ; R1j = NULL ; R1x = NULL ; // --------------------------------------------------------------------- // construct the A part of Y = [S B] // --------------------------------------------------------------------- ASSERT (anz == a2nz) ; py = 0 ; for (k = 0 ; k < n ; k++) { j = Q1fill ? Q1fill [k] : k ; ASSERT (py == Yp [k]) ; for (p = Ap [j] ; p < Ap [j+1] ; p++) { Yi [py] = Ai [p] ; Yx [py] = Ax [p] ; py++ ; } } ASSERT (py == anz) ; ASSERT (py == Yp [n]) ; // --------------------------------------------------------------------- // construct the B part of Y = [S B] // --------------------------------------------------------------------- if (Bsparse) { // B is sparse bnz = Bp [bncols] ; for (p = 0 ; p < bnz ; p++) { Yi [py++] = Bi [p] ; } py = anz ; for (p = 0 ; p < bnz ; p++) { Yx [py++] = Bx [p] ; } } else { // B is dense Entry *B1 = Bx ; for (k = 0 ; k < bncols ; k++) { ASSERT (py == Yp [n+k]) ; for (i = 0 ; i < m ; i++) { Entry bij = B1 [i] ; if (bij != (Entry) 0) { Yi [py] = i ; Yx [py] = bij ; py++ ; } } B1 += ldb ; } } ASSERT (py == ynz) ; } else { // --------------------------------------------------------------------- // R1p = cumsum ([0 R1p]) // --------------------------------------------------------------------- r1nz = spqr_cumsum (n1rows, R1p) ; // Int overflow cannot occur PR (("total nonzeros in R1: %ld\n", r1nz)) ; // --------------------------------------------------------------------- // allocate R1 // --------------------------------------------------------------------- R1j = (Int *) cholmod_l_malloc (r1nz, sizeof (Int ), cc) ; R1x = (Entry *) cholmod_l_malloc (r1nz, sizeof (Entry), cc) ; QR->R1j = R1j ; QR->R1x = R1x ; QR->r1nz = r1nz ; if (cc->status < CHOLMOD_OK) { // out of memory spqr_freefac (&QR, cc) ; cholmod_l_free_sparse (&Y, cc) ; return (NULL) ; } // --------------------------------------------------------------------- // scan A and construct R11 // --------------------------------------------------------------------- // At this point, R1p [i] points to the start of row i: // for (Int t = 0 ; t <= n1rows ; t++) Rsave [t] = R1p [t] ; for (k = 0 ; k < n1cols ; k++) { j = Q1fill ? Q1fill [k] : k ; for (p = Ap [j] ; p < Ap [j+1] ; p++) { // row i of A is row inew after singleton permutation i = Ai [p] ; inew = P1inv [i] ; ASSERT (inew < n1rows) ; // A (i,j) is in a singleton row. It becomes R1 (inew,k) p2 = R1p [inew]++ ; ASSERT (p2 < R1p [inew+1]) ; R1j [p2] = k ; R1x [p2] = Ax [p] ; } } // --------------------------------------------------------------------- // scan A and construct R12 and the S2 part of Y = [S2 B2] // --------------------------------------------------------------------- py = 0 ; for ( ; k < n ; k++) { j = Q1fill ? Q1fill [k] : k ; ASSERT (py == Yp [k-n1cols]) ; for (p = Ap [j] ; p < Ap [j+1] ; p++) { // row i of A is row inew after singleton permutation i = Ai [p] ; inew = P1inv [i] ; if (inew < n1rows) { // A (i,j) is in a singleton row. It becomes R1 (inew,k) p2 = R1p [inew]++ ; ASSERT (p2 < R1p [inew+1]) ; R1j [p2] = k ; R1x [p2] = Ax [p] ; } else { // A (i,j) is not in a singleton row. Place it in // Y (inew-n1rows, k-n1cols) Yi [py] = inew - n1rows ; Yx [py] = Ax [p] ; py++ ; } } } ASSERT (py == Yp [n-n1cols]) ; // --------------------------------------------------------------------- // restore the row pointers for R1 // --------------------------------------------------------------------- spqr_shift (n1rows, R1p) ; // the row pointers are back to what they were: // for (Int t = 0 ; t <= n1rows ; t++) ASSERT (Rsave [t] == R1p [t]) ; // --------------------------------------------------------------------- // construct the B2 part of Y = [S2 B2] // --------------------------------------------------------------------- if (Bsparse) { // B is sparse for (k = 0 ; k < bncols ; k++) { // construct the nonzero entries in column k of B2 ASSERT (py == Yp [k+(n-n1cols)]) ; for (p = Bp [k] ; p < Bp [k+1] ; p++) { iold = Bi [p] ; inew = P1inv [iold] ; if (inew >= n1rows) { Yi [py] = inew - n1rows ; Yx [py] = Bx [p] ; py++ ; } } } } else { // B is dense Entry *B1 = Bx ; for (k = 0 ; k < bncols ; k++) { // construct the nonzero entries in column k of B2 ASSERT (py == Yp [k+(n-n1cols)]) ; for (iold = 0 ; iold < m ; iold++) { inew = P1inv [iold] ; if (inew >= n1rows) { Entry bij = B1 [iold] ; if (bij != (Entry) 0) { Yi [py] = inew - n1rows ; Yx [py] = bij ; py++ ; } } } B1 += ldb ; } } ASSERT (py == ynz) ; } // ------------------------------------------------------------------------- // QR factorization of A or Y // ------------------------------------------------------------------------- if (noY) { // factorize A, with fill-reducing ordering already given in Q1fill QRsym = spqr_analyze (A, SPQR_ORDERING_GIVEN, Q1fill, tol >= 0, keepH, cc) ; #ifdef TIMING t1 = spqr_time ( ) ; #endif QRnum = spqr_factorize <Entry> (&A, FALSE, tol, n, QRsym, cc) ; } else { // fill-reducing ordering is already applied to Y; free Y when loaded QRsym = spqr_analyze (Y, SPQR_ORDERING_FIXED, NULL, tol >= 0, keepH, cc) ; #ifdef TIMING t1 = spqr_time ( ) ; #endif QRnum = spqr_factorize <Entry> (&Y, TRUE, tol, n2, QRsym, cc) ; // Y has been freed ASSERT (Y == NULL) ; } // record the actual ordering used (this will have been changed to GIVEN // or FIXED, in spqr_analyze, but change it back to the ordering used by // spqr_1fixed or spqr_1colamd. cc->SPQR_istat [7] = ordering ; QR->QRsym = QRsym ; QR->QRnum = QRnum ; if (cc->status < CHOLMOD_OK) { // out of memory spqr_freefac (&QR, cc) ; return (NULL) ; } cc->SPQR_istat [0] += r1nz ; // nnz (R) // rank estimate of A, including singletons but excluding the columns of // of B, in case [A B] was factorized. QR->rank = n1rows + QRnum->rank1 ; // ------------------------------------------------------------------------- // construct global row permutation if H is kept and singletons exist // ------------------------------------------------------------------------- // If there are no singletons, then HP1inv [0:m-1] and HPinv [0:m-1] would // be identical, so HP1inv is not needed. ASSERT ((n1cols == 0) == (P1inv == NULL)) ; ASSERT (IMPLIES (n1cols == 0, n1rows == 0)) ; if (keepH && n1cols > 0) { // construct the global row permutation. Currently, the row indices // in H reflect the global R. P1inv is the singleton permutation, // where a row index of Y = (P1inv (row of A) - n1rows), and // row of R2 = QRnum->HPinv (row of Y). Combine these two into // HP1inv, where a global row of R = HP1inv (a row of A) Int kk ; Int *HP1inv, *HPinv ; QR->HP1inv = HP1inv = (Int *) cholmod_l_malloc (m, sizeof (Int), cc) ; HPinv = QRnum->HPinv ; if (cc->status < CHOLMOD_OK) { // out of memory spqr_freefac (&QR, cc) ; return (NULL) ; } for (i = 0 ; i < m ; i++) { // i is a row of A, k is a row index after row singletons are // permuted. Then kk is a row index of the global R. k = P1inv ? P1inv [i] : i ; ASSERT (k >= 0 && k < m) ; if (k < n1rows) { kk = k ; } else { // k-n1rows is a row index of Y, the matrix factorized by // the QR factorization kernels (in QRsym and QRnum). // HPinv [k-n1rows] gives a row index of R2, to which n1rows // must be added to give a row of the global R. kk = HPinv [k - n1rows] + n1rows ; } ASSERT (kk >= 0 && kk < m) ; HP1inv [i] = kk ; } } // ------------------------------------------------------------------------- // find the mapping for the squeezed R, if A is rank deficient // ------------------------------------------------------------------------- if (QR->rank < n && !spqr_rmap <Entry> (QR, cc)) { // out of memory spqr_freefac (&QR, cc) ; return (NULL) ; } // ------------------------------------------------------------------------- // output statistics // ------------------------------------------------------------------------- cc->SPQR_istat [4] = QR->rank ; // estimated rank of A cc->SPQR_istat [5] = n1cols ; // number of columns singletons cc->SPQR_istat [6] = n1rows ; // number of singleton rows cc->SPQR_xstat [1] = tol ; // tol used #ifdef TIMING t2 = spqr_time ( ) ; cc->other1 [1] = t1 - t0 ; // analyze time, including singletons cc->other1 [2] = t2 - t1 ; // factorize time #endif return (QR) ; }
void mexFunction ( int nargout, mxArray *pargout [ ], int nargin, const mxArray *pargin [ ] ) { Int *P, *Q, *Rp, *Pinv ; double *Ax, dummy, tol ; Int m, n, anz, is_complex, n1rows, n1cols, i, k ; cholmod_sparse *A, Amatrix, *Y ; cholmod_common Common, *cc ; // ------------------------------------------------------------------------- // start CHOLMOD and set parameters // ------------------------------------------------------------------------- cc = &Common ; cholmod_l_start (cc) ; spqr_mx_config (SPUMONI, cc) ; // ------------------------------------------------------------------------- // check inputs // ------------------------------------------------------------------------- if (nargout > 5) { mexErrMsgIdAndTxt ("MATLAB:maxlhs", "Too many output arguments") ; } if (nargin < 1) { mexErrMsgIdAndTxt ("MATLAB:minrhs", "Not enough input arguments") ; } if (nargin > 2) { mexErrMsgIdAndTxt ("MATLAB:maxrhs", "Too many input arguments") ; } // ------------------------------------------------------------------------- // get the input matrix A and convert to merged-complex if needed // ------------------------------------------------------------------------- if (!mxIsSparse (pargin [0])) { mexErrMsgIdAndTxt ("QR:invalidInput", "A must be sparse") ; } A = spqr_mx_get_sparse (pargin [0], &Amatrix, &dummy) ; m = A->nrow ; n = A->ncol ; is_complex = mxIsComplex (pargin [0]) ; Ax = spqr_mx_merge_if_complex (pargin [0], is_complex, &anz, cc) ; if (is_complex) { // A has been converted from real or zomplex to complex A->x = Ax ; A->z = NULL ; A->xtype = CHOLMOD_COMPLEX ; } // ------------------------------------------------------------------------- // get the tolerance // ------------------------------------------------------------------------- if (nargin < 2) { tol = is_complex ? spqr_tol <Complex> (A,cc) : spqr_tol <double> (A,cc); } else { tol = mxGetScalar (pargin [1]) ; } // ------------------------------------------------------------------------- // find the singletons // ------------------------------------------------------------------------- if (is_complex) { spqr_1colamd <Complex> (SPQR_ORDERING_NATURAL, tol, 0, A, &Q, &Rp, &Pinv, &Y, &n1cols, &n1rows, cc) ; } else { spqr_1colamd <double> (SPQR_ORDERING_NATURAL, tol, 0, A, &Q, &Rp, &Pinv, &Y, &n1cols, &n1rows, cc) ; } // ------------------------------------------------------------------------- // free unused outputs from spqr_1colamd, and the merged-complex copy of A // ------------------------------------------------------------------------- cholmod_l_free (n1rows+1, sizeof (Int), Rp, cc) ; cholmod_l_free_sparse (&Y, cc) ; if (is_complex) { // this was allocated by merge_if_complex cholmod_l_free (anz, sizeof (Complex), Ax, cc) ; } // ------------------------------------------------------------------------- // find P from Pinv // ------------------------------------------------------------------------- P = (Int *) cholmod_l_malloc (m, sizeof (Int), cc) ; for (i = 0 ; i < m ; i++) { k = Pinv ? Pinv [i] : i ; P [k] = i ; } cholmod_l_free (m, sizeof (Int), Pinv, cc) ; // ------------------------------------------------------------------------- // return results // ------------------------------------------------------------------------- pargout [0] = spqr_mx_put_permutation (P, m, TRUE, cc) ; cholmod_l_free (m, sizeof (Int), P, cc) ; if (nargout > 1) pargout [1] = spqr_mx_put_permutation (Q, n, TRUE, cc) ; cholmod_l_free (n, sizeof (Int), Q, cc) ; if (nargout > 2) pargout [2] = mxCreateDoubleScalar ((double) n1rows) ; if (nargout > 3) pargout [3] = mxCreateDoubleScalar ((double) n1cols) ; if (nargout > 4) pargout [4] = mxCreateDoubleScalar (tol) ; cholmod_l_finish (cc) ; }
void mexFunction ( int nargout, mxArray *pargout [ ], int nargin, const mxArray *pargin [ ] ) { 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!") ; */ }
void mexFunction ( int nargout, mxArray *pargout [ ], int nargin, const mxArray *pargin [ ] ) { mxArray *Hmatlab, *Tau, *P ; Long *HPinv, *Yp, *Yi ; double *Hx, *Xx, *Tx, *Px, dummy ; Long m, n, k, nh, nb, p, i, method, mh, gotP, X_is_sparse, is_complex, hnz, tnz, xnz, inuse, count ; cholmod_sparse *Ysparse, *H, Hmatrix, *Xsparse, Xsmatrix ; cholmod_dense *Ydense, *Xdense, Xdmatrix, *HTau, HTau_matrix ; cholmod_common Common, *cc ; // ------------------------------------------------------------------------- // start CHOLMOD and set parameters // ------------------------------------------------------------------------- cc = &Common ; cholmod_l_start (cc) ; spqr_mx_config (SPUMONI, cc) ; // ------------------------------------------------------------------------- // check inputs // ------------------------------------------------------------------------- // nargin can be 2 or 3 // nargout can be 0 or 1 if (nargout > 1) { mexErrMsgIdAndTxt ("MATLAB:maxlhs", "Too many output arguments") ; } if (nargin < 2) { mexErrMsgIdAndTxt ("MATLAB:minrhs", "Not enough input arguments") ; } if (nargin > 3) { mexErrMsgIdAndTxt ("MATLAB:maxrhs", "Too many input arguments") ; } if (!mxIsStruct (pargin [0])) { mexErrMsgIdAndTxt ("QR:invalidInput", "invalid Q (must be a struct)") ; } // ------------------------------------------------------------------------- // get H, Tau, and P from the Q struct // ------------------------------------------------------------------------- i = mxGetFieldNumber (pargin [0], "H") ; if (i < 0) { mexErrMsgIdAndTxt ("QR:invalidInput", "invalid Q struct") ; } Hmatlab = mxGetFieldByNumber (pargin [0], 0, i) ; nh = mxGetN (Hmatlab) ; if (!mxIsSparse (Hmatlab)) { mexErrMsgIdAndTxt ("QR:invalidInput", "H must be sparse") ; } i = mxGetFieldNumber (pargin [0], "Tau") ; if (i < 0) { mexErrMsgIdAndTxt ("QR:invalidInput", "invalid Q struct") ; } Tau = mxGetFieldByNumber (pargin [0], 0, i) ; if (nh != mxGetNumberOfElements (Tau)) { mexErrMsgIdAndTxt ("QR:invalidInput", "H and Tau must have the same number of columns") ; } is_complex = mxIsComplex (Tau) || mxIsComplex (Hmatlab) || mxIsComplex (pargin [1]) ; // ------------------------------------------------------------------------- // get the Householder vectors // ------------------------------------------------------------------------- H = spqr_mx_get_sparse (Hmatlab, &Hmatrix, &dummy) ; mh = H->nrow ; Hx = spqr_mx_merge_if_complex (Hmatlab, is_complex, &hnz, cc) ; if (is_complex) { // H has been converted from real or zomplex to complex H->x = Hx ; H->z = NULL ; H->xtype = CHOLMOD_COMPLEX ; } // ------------------------------------------------------------------------- // get Tau // ------------------------------------------------------------------------- HTau = spqr_mx_get_dense (Tau, &HTau_matrix, &dummy) ; Tx = spqr_mx_merge_if_complex (Tau, is_complex, &tnz, cc) ; if (is_complex) { // HTau has been converted from real or zomplex to complex HTau->x = Tx ; HTau->z = NULL ; HTau->xtype = CHOLMOD_COMPLEX ; } // ------------------------------------------------------------------------- // get method // ------------------------------------------------------------------------- if (nargin < 3) { method = 0 ; } else { method = (Long) mxGetScalar (pargin [2]) ; if (method < 0 || method > 3) { mexErrMsgIdAndTxt ("QR:invalidInput", "invalid method") ; } } // ------------------------------------------------------------------------- // get X // ------------------------------------------------------------------------- m = mxGetM (pargin [1]) ; n = mxGetN (pargin [1]) ; X_is_sparse = mxIsSparse (pargin [1]) ; Xsparse = NULL ; if (X_is_sparse) { Xsparse = spqr_mx_get_sparse (pargin [1], &Xsmatrix, &dummy) ; } else { Xdense = spqr_mx_get_dense (pargin [1], &Xdmatrix, &dummy) ; } Xx = spqr_mx_merge_if_complex (pargin [1], is_complex, &xnz, cc) ; if (is_complex) { // X has been converted from real or zomplex to complex if (X_is_sparse) { Xsparse->x = Xx ; Xsparse->xtype = CHOLMOD_COMPLEX ; } else { Xdense->x = Xx ; Xdense->xtype = CHOLMOD_COMPLEX ; } } if (method == 0 || method == 1) { if (mh != m) { mexErrMsgIdAndTxt ("QR:invalidInput", "H and X must have same number of rows") ; } } else { if (mh != n) { mexErrMsgIdAndTxt ("QR:invalidInput", "# of cols of X must equal # of rows of H") ; } } // ------------------------------------------------------------------------- // get P // ------------------------------------------------------------------------- i = mxGetFieldNumber (pargin [0], "P") ; gotP = (i >= 0) ; HPinv = NULL ; if (gotP) { // get P from the H struct P = mxGetFieldByNumber (pargin [0], 0, i) ; if (mxGetNumberOfElements (P) != mh) { mexErrMsgIdAndTxt ("QR:invalidInput", "P must be a vector of length equal to # rows of H") ; } HPinv = (Long *) cholmod_l_malloc (mh, sizeof (Long), cc) ; Px = mxGetPr (P) ; for (i = 0 ; i < mh ; i++) { HPinv [i] = (Long) (Px [i] - 1) ; if (HPinv [i] < 0 || HPinv [i] >= mh) { mexErrMsgIdAndTxt ("QR:invalidInput", "invalid permutation") ; } } } // ------------------------------------------------------------------------- // Y = Q'*X, Q*X, X*Q or X*Q' // ------------------------------------------------------------------------- if (is_complex) { if (X_is_sparse) { Ysparse = SuiteSparseQR_qmult <Complex> (method, H, HTau, HPinv, Xsparse, cc) ; pargout [0] = spqr_mx_put_sparse (&Ysparse, cc) ; } else { Ydense = SuiteSparseQR_qmult <Complex> (method, H, HTau, HPinv, Xdense, cc) ; pargout [0] = spqr_mx_put_dense (&Ydense, cc) ; } } else { if (X_is_sparse) { Ysparse = SuiteSparseQR_qmult <double> (method, H, HTau, HPinv, Xsparse, cc) ; pargout [0] = spqr_mx_put_sparse (&Ysparse, cc) ; } else { Ydense = SuiteSparseQR_qmult <double> (method, H, HTau, HPinv, Xdense, cc) ; pargout [0] = spqr_mx_put_dense (&Ydense, cc) ; } } // ------------------------------------------------------------------------- // free workspace // ------------------------------------------------------------------------- cholmod_l_free (mh, sizeof (Long), HPinv, cc) ; if (is_complex) { // free the merged copies of the real parts of the H and Tau matrices cholmod_l_free (hnz, sizeof (Complex), Hx, cc) ; cholmod_l_free (tnz, sizeof (Complex), Tx, cc) ; cholmod_l_free (xnz, sizeof (Complex), Xx, cc) ; } cholmod_l_finish (cc) ; #if 0 // malloc count for testing only ... spqr_mx_get_usage (pargout [0], 1, &inuse, &count, cc) ; if (inuse != cc->memory_inuse || count != cc->malloc_count) { mexErrMsgIdAndTxt ("QR:internalError", "memory leak!") ; } #endif }
template <typename Entry> int spqr_1fixed ( // inputs, not modified double tol, // only accept singletons above tol Long bncols, // number of columns of B cholmod_sparse *A, // m-by-n sparse matrix // output arrays, neither allocated nor defined on input. Long **p_R1p, // size n1rows+1, R1p [k] = # of nonzeros in kth // row of R1. NULL if n1cols == 0. Long **p_P1inv, // size m, singleton row inverse permutation. // If row i of A is the kth singleton row, then // P1inv [i] = k. NULL if n1cols is zero. cholmod_sparse **p_Y, // on output, only the first n-n1cols+1 entries of // Y->p are defined (if Y is not NULL), where // Y = [A B] or Y = [A2 B2]. If B is empty and // there are no column singletons, Y is NULL Long *p_n1cols, // number of column singletons found Long *p_n1rows, // number of corresponding rows found // workspace and parameters cholmod_common *cc ) { cholmod_sparse *Y ; Long *P1inv, *R1p, *Yp, *Qrows, *Ap, *Ai ; char *Mark ; Entry *Ax ; Long i, j, k, p, d, row, n1rows, n1cols, ynz, iold, inew, kk, m, n, xtype ; // ------------------------------------------------------------------------- // get inputs // ------------------------------------------------------------------------- xtype = spqr_type <Entry> ( ) ; m = A->nrow ; n = A->ncol ; Ap = (Long *) A->p ; Ai = (Long *) A->i ; Ax = (Entry *) A->x ; // set outputs to NULL in case of early return *p_R1p = NULL ; *p_P1inv = NULL ; *p_Y = NULL ; *p_n1cols = EMPTY ; *p_n1rows = EMPTY ; // ------------------------------------------------------------------------- // allocate workspace // ------------------------------------------------------------------------- Mark = (char *) cholmod_l_calloc (m, sizeof (char), cc) ; Qrows = (Long *) cholmod_l_malloc (n, sizeof (Long), cc) ; if (cc->status < CHOLMOD_OK) { // out of memory cholmod_l_free (m, sizeof (char), Mark, cc) ; cholmod_l_free (n, sizeof (Long), Qrows, cc) ; return (FALSE) ; } // ------------------------------------------------------------------------- // find singletons; no column permutations allowed // ------------------------------------------------------------------------- n1cols = 0 ; // number of column singletons found n1rows = 0 ; // number of corresponding singleton rows for (j = 0 ; j < n ; j++) { // count the number of unmarked rows in column j Entry aij = 0 ; d = 0 ; row = EMPTY ; for (p = Ap [j] ; d < 2 && p < Ap [j+1] ; p++) { i = Ai [p] ; if (!Mark [i]) { // row i is not taken by a prior column singleton. If this // is the only unflagged row and the value is large enough, // it will become the row for this column singleton. aij = Ax [p] ; row = i ; d++ ; } } if (d == 0) { // j is a dead column singleton Qrows [n1cols++] = EMPTY ; } else if (d == 1 && spqr_abs (aij, cc) > tol) { // j is a live column singleton Qrows [n1cols++] = row ; // flag row i as taken Mark [row] = TRUE ; n1rows++ ; } else { // j is not a singleton; quit searching break ; } } // ------------------------------------------------------------------------- // construct P1inv permutation, row counts R1p, and col pointers Yp // ------------------------------------------------------------------------- if (n1cols == 0 && bncols == 0) { // --------------------------------------------------------------------- // no singletons, and B empty; Y=A will be done via pointer alias // --------------------------------------------------------------------- Y = NULL ; Yp = NULL ; P1inv = NULL ; R1p = NULL ; } else if (n1cols == 0) { // --------------------------------------------------------------------- // no singletons in the matrix; no R1 matrix, no P1inv permutation // --------------------------------------------------------------------- // Y has no entries yet; nnz(Y) will be determined later Y = cholmod_l_allocate_sparse (m, n+bncols, 0, FALSE, TRUE, 0, xtype, cc) ; if (cc->status < CHOLMOD_OK) { // out of memory cholmod_l_free (m, sizeof (char), Mark, cc) ; cholmod_l_free (n, sizeof (Long), Qrows, cc) ; return (FALSE) ; } Yp = (Long *) Y->p ; ASSERT (n1rows == 0) ; P1inv = NULL ; R1p = NULL ; // --------------------------------------------------------------------- // copy the column pointers of A for the first part of Y = [A B] // --------------------------------------------------------------------- ynz = Ap [n] ; for (k = 0 ; k <= n ; k++) { Yp [k] = Ap [k] ; } } else { // --------------------------------------------------------------------- // construct the row singleton permutation // --------------------------------------------------------------------- // Y has no entries yet; nnz(Y) will be determined later Y = cholmod_l_allocate_sparse (m-n1rows, n-n1cols+bncols, 0, TRUE, TRUE, 0, xtype, cc) ; P1inv = (Long *) cholmod_l_malloc (m, sizeof (Long), cc) ; R1p = (Long *) cholmod_l_calloc (n1rows+1, sizeof (Long), cc) ; if (cc->status < CHOLMOD_OK) { // out of memory cholmod_l_free_sparse (&Y, cc) ; cholmod_l_free (m, sizeof (Long), P1inv, cc) ; cholmod_l_free (n1rows+1, sizeof (Long), R1p, cc) ; cholmod_l_free (m, sizeof (char), Mark, cc) ; cholmod_l_free (n, sizeof (Long), Qrows, cc) ; return (FALSE) ; } Yp = (Long *) Y->p ; #ifndef NDEBUG for (i = 0 ; i < m ; i++) P1inv [i] = EMPTY ; #endif kk = 0 ; for (k = 0 ; k < n1cols ; k++) { i = Qrows [k] ; if (i != EMPTY) { // row i is the kk-th singleton row ASSERT (Mark [i]) ; ASSERT (P1inv [i] == EMPTY) ; P1inv [i] = kk ; kk++ ; } } for (i = 0 ; i < m ; i++) { if (!Mark [i]) { // row i is not a singleton row ASSERT (P1inv [i] == EMPTY) ; P1inv [i] = kk ; kk++ ; } } ASSERT (kk == m) ; // --------------------------------------------------------------------- // find row counts for R11 // --------------------------------------------------------------------- for (k = 0 ; k < n1cols ; k++) { for (p = Ap [k] ; p < Ap [k+1] ; p++) { iold = Ai [p] ; inew = P1inv [iold] ; ASSERT (inew < n1rows) ; R1p [inew]++ ; // a singleton row; in R1 } } // --------------------------------------------------------------------- // find row counts for R12 and column pointers for A2 part of Y // --------------------------------------------------------------------- ynz = 0 ; for ( ; k < n ; k++) { Yp [k-n1cols] = ynz ; for (p = Ap [k] ; p < Ap [k+1] ; p++) { iold = Ai [p] ; inew = P1inv [iold] ; if (inew < n1rows) { R1p [inew]++ ; // a singleton row; in R1 } else { ynz++ ; // not a singleton row; in A2 } } } Yp [n-n1cols] = ynz ; #ifndef NDEBUG PR (("n1cols: %ld\n", n1cols)) ; for (i = 0 ; i < n1rows ; i++) { PR (("R1p [%ld] is %ld\n", i, R1p [i])) ; ASSERT (R1p [i] > 0) ; } #endif } // ------------------------------------------------------------------------- // free workspace and return results // ------------------------------------------------------------------------- cholmod_l_free (n, sizeof (Long), Qrows, cc) ; cholmod_l_free (m, sizeof (char), Mark, cc) ; *p_R1p = R1p ; *p_P1inv = P1inv ; *p_Y = Y ; *p_n1cols = n1cols ; *p_n1rows = n1rows ; return (TRUE) ; }