/** * Copy the contents of N to a csn_LU or csn_QR object and, * optionally, free N or free both N and the pointers to its contents. * * @param a csn object to be converted * @param cl the name of the S4 class of the object to be generated * @param dofree 0 - don't free a; > 0 cs_free a; < 0 Free a * * @return SEXP containing a copy of S */ SEXP Matrix_csn_to_SEXP(csn *N, char *cl, int dofree) { SEXP ans; char *valid[] = {"csn_LU", "csn_QR", ""}; int ctype = Matrix_check_class(cl, valid), n = (N->U)->n; if (ctype < 0) error("Inappropriate class '%s' for Matrix_csn_to_SEXP", cl); ans = PROTECT(NEW_OBJECT(MAKE_CLASS(cl))); /* allocate and copy common slots */ /* FIXME: Use the triangular matrix classes for csn_LU */ SET_SLOT(ans, install("L"), /* these are free'd later if requested */ Matrix_cs_to_SEXP(N->L, "dgCMatrix", 0)); SET_SLOT(ans, install("U"), Matrix_cs_to_SEXP(N->U, "dgCMatrix", 0)); switch(ctype) { case 0: Memcpy(INTEGER(ALLOC_SLOT(ans, install("Pinv"), INTSXP, n)), N->pinv, n); break; case 1: Memcpy(REAL(ALLOC_SLOT(ans, install("beta"), REALSXP, n)), N->B, n); break; default: error("Inappropriate class '%s' for Matrix_csn_to_SEXP", cl); } if (dofree > 0) cs_nfree(N); if (dofree < 0) { Free(N->L); Free(N->U); Free(N); } UNPROTECT(1); return ans; }
/* free workspace and return a numeric factorization (Cholesky, LU, or QR) */ csn *cs_ndone (csn *N, cs *C, void *w, void *x, int ok) { cs_spfree (C) ; /* free temporary matrix */ cs_free (w) ; /* free workspace */ cs_free (x) ; return (ok ? N : cs_nfree (N)) ; /* return result if OK, else free it */ }
/** * @brief Cleans up a sparse matrix factorization. * * @param[in] fact Factorization to clean up. */ void cs_fact_free( cs_fact_t *fact ) { if (fact == NULL) return; switch (fact->type) { case CS_FACT_NULL: break; case CS_FACT_CHOLESKY: case CS_FACT_LU: case CS_FACT_QR: cs_free( fact->x ); cs_sfree( fact->S ); cs_nfree( fact->N ); break; case CS_FACT_UMFPACK: #ifdef USE_UMFPACK cs_spfree( fact->A ); umfpack_di_free_numeric( &fact->numeric ); free( fact->x ); free( fact->wi ); free( fact->w ); #endif /* USE_UMFPACK */ break; } free( fact ); }
void SparseCholeskySolver<TMatrix,TVector>::invert(Matrix& M) { int order = -1; //????? if (S) cs_sfree(S); if (N) cs_nfree(N); //if (tmp) cs_free(tmp); M.compress(); A.nzmax = M.getColsValue().size(); // maximum number of entries A_p = (int *) &(M.getRowBegin()[0]); A_i = (int *) &(M.getColsIndex()[0]); A_x.resize(A.nzmax); for (int i=0;i<A.nzmax;i++) A_x[i] = (double) M.getColsValue()[i]; //remplir A avec M A.m = M.rowBSize(); // number of rows A.n = M.colBSize(); // number of columns A.p = A_p; // column pointers (size n+1) or col indices (size nzmax) A.i = A_i; // row indices, size nzmax A.x = (double*) &(A_x[0]); // numerical values, size nzmax A.nz = -1; // # of entries in triplet matrix, -1 for compressed-col cs_dropzeros( &A ); //M.check_matrix(); //CompressedRowSparseMatrix<double>::check_matrix(-1 /*A.nzmax*/,A.m,A.n,A.p,A.i,A.x); //sout << "diag ="; //for (int i=0;i<A.n;++i) sout << " " << M.element(i,i); //sout << sendl; //sout << "SparseCholeskySolver: start factorization, n = " << A.n << " nnz = " << A.p[A.n] << sendl; //tmp = (double *) cs_malloc (A.n, sizeof (double)) ; tmp.resize(A.n); S = cs_schol (&A, order) ; /* ordering and symbolic analysis */ N = cs_chol (&A, S) ; /* numeric Cholesky factorization */ //sout << "SparseCholeskySolver: factorization complete, nnz = " << N->L->p[N->L->n] << sendl; }
/* Modified version of Tim Davis's cs_lu_mex.c file for MATLAB */ void install_lu(SEXP Ap, int order, double tol, Rboolean err_sing) { // (order, tol) == (1, 1) by default, when called from R. SEXP ans; css *S; csn *N; int n, *p, *dims; CSP A = AS_CSP__(Ap), D; R_CheckStack(); n = A->n; if (A->m != n) error(_("LU decomposition applies only to square matrices")); if (order) { /* not using natural order */ order = (tol == 1) ? 2 /* amd(S'*S) w/dense rows or I */ : 1; /* amd (A+A'), or natural */ } S = cs_sqr(order, A, /*qr = */ 0); /* symbolic ordering */ N = cs_lu(A, S, tol); /* numeric factorization */ if (!N) { if(err_sing) error(_("cs_lu(A) failed: near-singular A (or out of memory)")); else { /* No warning: The useR should be careful : * Put NA into "LU" factor */ set_factors(Ap, ScalarLogical(NA_LOGICAL), "LU"); return; } } cs_dropzeros(N->L); /* drop zeros from L and sort it */ D = cs_transpose(N->L, 1); cs_spfree(N->L); N->L = cs_transpose(D, 1); cs_spfree(D); cs_dropzeros(N->U); /* drop zeros from U and sort it */ D = cs_transpose(N->U, 1); cs_spfree(N->U); N->U = cs_transpose(D, 1); cs_spfree(D); p = cs_pinv(N->pinv, n); /* p=pinv' */ ans = PROTECT(NEW_OBJECT(MAKE_CLASS("sparseLU"))); dims = INTEGER(ALLOC_SLOT(ans, Matrix_DimSym, INTSXP, 2)); dims[0] = n; dims[1] = n; SET_SLOT(ans, install("L"), Matrix_cs_to_SEXP(N->L, "dtCMatrix", 0)); SET_SLOT(ans, install("U"), Matrix_cs_to_SEXP(N->U, "dtCMatrix", 0)); Memcpy(INTEGER(ALLOC_SLOT(ans, Matrix_pSym, /* "p" */ INTSXP, n)), p, n); if (order) Memcpy(INTEGER(ALLOC_SLOT(ans, install("q"), INTSXP, n)), S->q, n); cs_nfree(N); cs_sfree(S); cs_free(p); UNPROTECT(1); set_factors(Ap, ans, "LU"); }
void free_var(ode_workspace *odews) { if (odews->W->buf != NULL) free(odews->W->buf); if (odews->W->flag != NULL) free(odews->W->flag); if (odews->W->level != NULL) free(odews->W->level); if (odews->W->l != NULL) free(odews->W->l); if (odews->W->x != NULL) free(odews->W->x); if (odews->W->y != NULL) free(odews->W->y); if (odews->W->b != NULL) free(odews->W->b); if (odews->W->u != NULL) free(odews->W->u); if (odews->W->v != NULL) free(odews->W->v); if (odews->W->p != NULL) free(odews->W->p); if (odews->W->q != NULL) free(odews->W->q); if (odews->W->w != NULL) free(odews->W->w); if (odews->W->ucomm != NULL) free(odews->W->ucomm); if (odews->W->vcomm != NULL) free(odews->W->vcomm); if (odews->W->gcomm != NULL) free(odews->W->gcomm); if (odews->W->xn != NULL) free(odews->W->xn); if (odews->W->xm != NULL) free(odews->W->xm); if (odews->W->level0 != NULL) free(odews->W->level0); if (odews->W->b0 != NULL) free(odews->W->b0); if (odews->W->p0 != NULL) free(odews->W->p0); if (odews->W->q0 != NULL) free(odews->W->q0); if (odews->W->xn0 != NULL) free(odews->W->xn0); if (odews->W->J != NULL) cs_spfree(odews->W->J); if (odews->W->dfdx->r != NULL) free(odews->W->dfdx->r); if (odews->W->dfdx->g != NULL) free(odews->W->dfdx->g); if (odews->W->dfdx->A != NULL) cs_spfree(odews->W->dfdx->A); if (odews->W->dfdx != NULL) free(odews->W->dfdx); if (odews->W->A != NULL) cs_spfree(odews->W->A); if (odews->W->At != NULL) cs_spfree(odews->W->At); if (odews->W->A_A != NULL) cs_spfree(odews->W->A_A); if (odews->W->A_At != NULL) cs_spfree(odews->W->A_At); if (odews->W->dpdgneg != NULL) cs_spfree(odews->W->dpdgneg); if (odews->W->dfdp->r != NULL) free(odews->W->dfdp->r); if (odews->W->dfdp->g != NULL) free(odews->W->dfdp->g); if (odews->W->dfdp->A != NULL) cs_spfree(odews->W->dfdp->A); if (odews->W->dfdp != NULL) free(odews->W->dfdp); if (odews->W->G != NULL) cs_spfree(odews->W->G); if (odews->W->dgdx != NULL) cs_spfree(odews->W->dgdx); if (odews->W->Proj != NULL) cs_spfree(odews->W->Proj); if (odews->W->symbchol != NULL) cs_sfree(odews->W->symbchol); if (odews->W->symbchol_reduced != NULL) cs_sfree(odews->W->symbchol_reduced); if (odews->W->nvu_w->dfdx_pattern != NULL) cs_spfree(odews->W->nvu_w->dfdx_pattern); if (odews->W->nvu_w->dfdp_pattern != NULL) cs_spfree(odews->W->nvu_w->dfdp_pattern); if (odews->W->nvu_w != NULL) free(odews->W->nvu_w); if (odews->W->symbchol0 != NULL) cs_sfree(odews->W->symbchol0); if (odews->W->G0 != NULL) cs_spfree(odews->W->G0); if (odews->W->A0 != NULL) cs_spfree(odews->W->A0); if (odews->W->A0t != NULL) cs_spfree(odews->W->A0t); if (odews->W != NULL) free(odews->W); if (odews->N != NULL) cs_nfree(odews->N); if (odews->y != NULL) free(odews->y); if (odews->f != NULL) free(odews->f); }
/* free workspace for demo3 */ static int done3 (int ok, css *S, csn *N, double *y, cs *W, cs *E, int *p) { cs_sfree (S) ; cs_nfree (N) ; cs_free (y) ; cs_spfree (W) ; cs_spfree (E) ; cs_free (p) ; return (ok) ; }
/* x=A\b where A can be rectangular; b overwritten with solution */ int cs_qrsol (int order, const cs *A, double *b) { double *x ; css *S ; csn *N ; cs *AT = NULL ; int k, m, n, ok ; if (!CS_CSC (A) || !b) return (0) ; /* check inputs */ n = A->n ; m = A->m ; if (m >= n) { S = cs_sqr (order, A, 1) ; /* ordering and symbolic analysis */ N = cs_qr (A, S) ; /* numeric QR factorization */ x = cs_calloc (S ? S->m2 : 1, sizeof (double)) ; /* get workspace */ ok = (S && N && x) ; if (ok) { cs_ipvec (S->pinv, b, x, m) ; /* x(0:m-1) = b(p(0:m-1) */ for (k = 0 ; k < n ; k++) /* apply Householder refl. to x */ { cs_happly (N->L, k, N->B [k], x) ; } cs_usolve (N->U, x) ; /* x = R\x */ cs_ipvec (S->q, x, b, n) ; /* b(q(0:n-1)) = x(0:n-1) */ } } else { AT = cs_transpose (A, 1) ; /* Ax=b is underdetermined */ S = cs_sqr (order, AT, 1) ; /* ordering and symbolic analysis */ N = cs_qr (AT, S) ; /* numeric QR factorization of A' */ x = cs_calloc (S ? S->m2 : 1, sizeof (double)) ; /* get workspace */ ok = (AT && S && N && x) ; if (ok) { cs_pvec (S->q, b, x, m) ; /* x(q(0:m-1)) = b(0:m-1) */ cs_utsolve (N->U, x) ; /* x = R'\x */ for (k = m-1 ; k >= 0 ; k--) /* apply Householder refl. to x */ { cs_happly (N->L, k, N->B [k], x) ; } cs_pvec (S->pinv, x, b, n) ; /* b(0:n-1) = x(p(0:n-1)) */ } } cs_free (x) ; cs_sfree (S) ; cs_nfree (N) ; cs_spfree (AT) ; return (ok) ; }
/* cs_lu: sparse LU factorization, with optional fill-reducing ordering */ void mexFunction ( int nargout, mxArray *pargout [ ], int nargin, const mxArray *pargin [ ] ) { css *S ; csn *N ; cs Amatrix, *A, *D ; csi n, order, *p ; double tol ; if (nargout > 4 || nargin > 3 || nargin < 1) { mexErrMsgTxt ("Usage: [L,U,p,q] = cs_lu (A,tol)") ; } A = cs_mex_get_sparse (&Amatrix, 1, 1, pargin [0]) ; /* get A */ n = A->n ; if (nargin == 2) /* determine tol and ordering */ { tol = mxGetScalar (pargin [1]) ; order = (nargout == 4) ? 1 : 0 ; /* amd (A+A'), or natural */ } else { tol = 1 ; order = (nargout == 4) ? 2 : 0 ; /* amd(S'*S) w/dense rows or I */ } S = cs_sqr (order, A, 0) ; /* symbolic ordering, no QR bound */ N = cs_lu (A, S, tol) ; /* numeric factorization */ if (!N) mexErrMsgTxt ("cs_lu failed (singular, or out of memory)") ; cs_dropzeros (N->L) ; /* drop zeros from L and sort it */ D = cs_transpose (N->L, 1) ; cs_spfree (N->L) ; N->L = cs_transpose (D, 1) ; cs_spfree (D) ; cs_dropzeros (N->U) ; /* drop zeros from U and sort it */ D = cs_transpose (N->U, 1) ; cs_spfree (N->U) ; N->U = cs_transpose (D, 1) ; cs_spfree (D) ; p = cs_pinv (N->pinv, n) ; /* p=pinv' */ pargout [0] = cs_mex_put_sparse (&(N->L)) ; /* return L */ pargout [1] = cs_mex_put_sparse (&(N->U)) ; /* return U */ pargout [2] = cs_mex_put_int (p, n, 1, 1) ; /* return p */ /* return Q */ if (nargout == 4) pargout [3] = cs_mex_put_int (S->q, n, 1, 0) ; cs_nfree (N) ; cs_sfree (S) ; }
void CSparseCholeskyInternal::prepare() { prepared_ = false; // Get a reference to the nonzeros of the linear system const vector<double>& linsys_nz = input().data(); // Make sure that all entries of the linear system are valid for (int k=0; k<linsys_nz.size(); ++k) { casadi_assert_message(!isnan(linsys_nz[k]), "Nonzero " << k << " is not-a-number"); casadi_assert_message(!isinf(linsys_nz[k]), "Nonzero " << k << " is infinite"); } if (verbose()) { userOut() << "CSparseCholeskyInternal::prepare: numeric factorization" << endl; userOut() << "linear system to be factorized = " << endl; input(0).printSparse(); } if (L_) cs_nfree(L_); L_ = cs_chol(&AT_, S_) ; // numeric Cholesky factorization if (L_==0) { DMatrix temp = input(); temp.makeSparse(); if (temp.sparsity().issingular()) { stringstream ss; ss << "CSparseCholeskyInternal::prepare: factorization failed due " "to matrix being singular. Matrix contains numerical zeros which are" " structurally non-zero. Promoting these zeros to be structural " "zeros, the matrix was found to be structurally rank deficient. " "sprank: " << sprank(temp.sparsity()) << " <-> " << temp.size2() << endl; if (verbose()) { ss << "Sparsity of the linear system: " << endl; input(LINSOL_A).sparsity().print(ss); // print detailed } throw CasadiException(ss.str()); } else { stringstream ss; ss << "CSparseCholeskyInternal::prepare: factorization failed, " "check if Jacobian is singular" << endl; if (verbose()) { ss << "Sparsity of the linear system: " << endl; input(LINSOL_A).sparsity().print(ss); // print detailed } throw CasadiException(ss.str()); } } casadi_assert(L_!=0); prepared_ = true; }
// Modified version of Tim Davis's cs_qr_mex.c file for MATLAB (in CSparse) // Usage: [V,beta,p,R,q] = cs_qr(A) ; SEXP dgCMatrix_QR(SEXP Ap, SEXP order) { CSP A = AS_CSP__(Ap), D; int io = INTEGER(order)[0]; Rboolean verbose = (io < 0); int m = A->m, n = A->n, ord = asLogical(order) ? 3 : 0, *p; R_CheckStack(); if (m < n) error(_("A must have #{rows} >= #{columns}")) ; SEXP ans = PROTECT(NEW_OBJECT(MAKE_CLASS("sparseQR"))); int *dims = INTEGER(ALLOC_SLOT(ans, Matrix_DimSym, INTSXP, 2)); dims[0] = m; dims[1] = n; css *S = cs_sqr(ord, A, 1); /* symbolic QR ordering & analysis*/ if (!S) error(_("cs_sqr failed")); if(verbose && S->m2 > m) // in ./cs.h , m2 := # of rows for QR, after adding fictitious rows Rprintf("Symbolic QR(): Matrix structurally rank deficient (m2-m = %d)\n", S->m2 - m); csn *N = cs_qr(A, S); /* numeric QR factorization */ if (!N) error(_("cs_qr failed")) ; cs_dropzeros(N->L); /* drop zeros from V and sort */ D = cs_transpose(N->L, 1); cs_spfree(N->L); N->L = cs_transpose(D, 1); cs_spfree(D); cs_dropzeros(N->U); /* drop zeros from R and sort */ D = cs_transpose(N->U, 1); cs_spfree(N->U) ; N->U = cs_transpose(D, 1); cs_spfree(D); m = N->L->m; /* m may be larger now */ // MM: m := S->m2 also counting the ficticious rows (Tim Davis, p.72, 74f) p = cs_pinv(S->pinv, m); /* p = pinv' */ SET_SLOT(ans, install("V"), Matrix_cs_to_SEXP(N->L, "dgCMatrix", 0)); Memcpy(REAL(ALLOC_SLOT(ans, install("beta"), REALSXP, n)), N->B, n); Memcpy(INTEGER(ALLOC_SLOT(ans, Matrix_pSym, INTSXP, m)), p, m); SET_SLOT(ans, install("R"), Matrix_cs_to_SEXP(N->U, "dgCMatrix", 0)); if (ord) Memcpy(INTEGER(ALLOC_SLOT(ans, install("q"), INTSXP, n)), S->q, n); else ALLOC_SLOT(ans, install("q"), INTSXP, 0); cs_nfree(N); cs_sfree(S); cs_free(p); UNPROTECT(1); return ans; }
void CSparseCholeskyInterface::factorize(void* mem, const double* A) const { auto m = static_cast<CsparseCholMemory*>(mem); // Set the nonzeros of the matrix m->A.x = const_cast<double*>(A); // Make sure that all entries of the linear system are valid int nnz = m->nnz(); for (int k=0; k<nnz; ++k) { casadi_assert_message(!isnan(A[k]), "Nonzero " << k << " is not-a-number"); casadi_assert_message(!isinf(A[k]), "Nonzero " << k << " is infinite"); } if (m->L) cs_nfree(m->L); m->L = cs_chol(&m->A, m->S) ; // numeric Cholesky factorization casadi_assert(m->L!=0); }
cs *cs_rinvwishart(const cs *A, double nu, const css *As){ int m, i, j, cnt; cs *T, *IW, *C, *W, *tC; csn *U; m = A->n; T = cs_spalloc (m, m, m*(m+1)/2, 1, 0) ; if (!T ) return (cs_done (T, NULL, NULL, 0)); double df = nu; cnt = 0; for(i = 0; i<m; i++){ T->p[i] = cnt; T->i[cnt] = i; T->x[cnt] = sqrt(rchisq(df)); cnt++; for(j = i+1; j<m; j++){ T->i[cnt] = j; T->x[cnt] = rnorm(0.0,1.0); cnt++; } df--; } T->p[m] = m*(m+1)/2; U = cs_chol(A, As); if(U==NULL){ PutRNGstate(); error("ill-conditioned cross-product: can't form Cholesky factor\n"); } C = cs_multiply(U->L,T); // t(T)%*%chol(A) tC = cs_transpose(C, TRUE); // t(CI) W = cs_multiply(C,tC); IW = cs_inv(W); // crossprod(t(CI)) cs_spfree(T); cs_nfree(U); cs_spfree(C); cs_spfree(tC); cs_spfree(W); return (cs_done (IW, NULL, NULL, 1)) ; /* success; free workspace, return C */ }
/* cs_qr: sparse QR factorization */ void mexFunction ( int nargout, mxArray *pargout [ ], int nargin, const mxArray *pargin [ ] ) { css *S ; csn *N ; cs Amatrix, *A, *D ; csi m, n, order, *p ; if (nargout > 5 || nargin != 1) { mexErrMsgTxt ("Usage: [V,beta,p,R,q] = cs_qr(A)") ; } A = cs_mex_get_sparse (&Amatrix, 0, 1, pargin [0]) ; /* get A */ m = A->m ; n = A->n ; if (m < n) mexErrMsgTxt ("A must have # rows >= # columns") ; order = (nargout == 5) ? 3 : 0 ; /* determine ordering */ S = cs_sqr (order, A, 1) ; /* symbolic QR ordering & analysis*/ N = cs_qr (A, S) ; /* numeric QR factorization */ if (!N) mexErrMsgTxt ("qr failed") ; cs_dropzeros (N->L) ; /* drop zeros from V and sort */ D = cs_transpose (N->L, 1) ; cs_spfree (N->L) ; N->L = cs_transpose (D, 1) ; cs_spfree (D) ; cs_dropzeros (N->U) ; /* drop zeros from R and sort */ D = cs_transpose (N->U, 1) ; cs_spfree (N->U) ; N->U = cs_transpose (D, 1) ; cs_spfree (D) ; m = N->L->m ; /* m may be larger now */ p = cs_pinv (S->pinv, m) ; /* p = pinv' */ pargout [0] = cs_mex_put_sparse (&(N->L)) ; /* return V */ cs_mex_put_double (n, N->B, &(pargout [1])) ; /* return beta */ pargout [2] = cs_mex_put_int (p, m, 1, 1) ; /* return p */ pargout [3] = cs_mex_put_sparse (&(N->U)) ; /* return R */ pargout [4] = cs_mex_put_int (S->q, n, 1, 0) ; /* return q */ cs_nfree (N) ; cs_sfree (S) ; }
void NM_csparse_free(void* p) { assert(p); NumericsSparseLinearSolverParams* ptr = (NumericsSparseLinearSolverParams*) p; cs_lu_factors* cs_lu_A = NM_csparse_lu_factors(ptr); if (cs_lu_A) { cs_lu_A->n = -1; cs_sfree(cs_lu_A->S); cs_lu_A->S = NULL; cs_nfree(cs_lu_A->N); cs_lu_A->N = NULL; free(cs_lu_A); } ptr->solver_data = NULL; }
void newton_matrix(ode_workspace *odews) { // Create a Newton matrix from the given step gamma and Jacobian in W cs *M, *eye; if (odews->mdeclared) { cs_nfree(odews->N); } else { odews->mdeclared = 1; } eye = speye(odews->W->J->m); M = cs_add(eye, odews->W->J, 1, -odews->dt); cs_spfree(eye); odews->N = cs_lu(M, odews->S, 1); cs_spfree(M); }
/** * @brief Performs QR factorization on a matrix. * * @param[in,out] qrd QR factorization of the matrix. * @param[in] A Matrix to factorize. * @return 0 on success. */ static int cs_fact_init_qr( cs_fact_t *qrd, const cs *A ) { int order = 3; /* order 0:natural, 1:Chol, 2:LU, 3:QR */ qrd->S = cs_sqr( order, A, 1 ); if (qrd->S == NULL) goto err_S; qrd->N = cs_qr( A, qrd->S ); if (qrd->N == NULL) goto err_N; qrd->x = cs_malloc( qrd->S->m2, sizeof(double) ); if (qrd->x == NULL) goto err_x; qrd->type = CS_FACT_QR; return 0; err_x: cs_nfree( qrd->N ); err_N: cs_sfree( qrd->S ); err_S: return -1; }
/** * @brief Performs Cholesky factorization on a matrix. * * @param[in,out] chold Cholesky factorization of the matrix. * @param[in] A Matrix to factorize. * @return 0 on success. */ static int cs_fact_init_cholesky( cs_fact_t *chold, const cs *A ) { int order = 1; /* order 0:natural, 1:Chol, 2:LU, 3:QR */ chold->S = cs_schol( order, A ); if (chold->S == NULL) goto err_S; chold->N = cs_chol( A, chold->S ); if (chold->N == NULL) goto err_N; chold->x = cs_malloc( A->n, sizeof(double) ); if (chold->x == NULL) goto err_x; chold->type = CS_FACT_CHOLESKY; return 0; err_x: cs_nfree( chold->N ); err_N: cs_sfree( chold->S ); err_S: return -1; }
/* x=A\b where A is unsymmetric; b overwritten with solution */ csi cs_lusol_modifier (csi order, const cs *A, double *b, double *a, double tol) { double *x ; css *S ; csn *N ; csi n, ok ; // if (!CS_CSC (A) || !b) return (0) ; /* check inputs */ n = A->n ; S = cs_sqr (order, A, 0) ; /* ordering and symbolic analysis */ N = cs_lu (A, S, tol) ; /* numeric LU factorization */ x = cs_malloc (n, sizeof (double)) ; /* get workspace */ // ok = (S && N && x) ; //if (ok) //{ cs_ipvec (N->pinv, b, x, n) ; /* x = b(p) */ cs_lsolve (N->L, x) ; /* x = L\x */ cs_usolve (N->U, x) ; /* x = U\x */ cs_ipvec (S->q, x, a, n) ; /* b(q) = x */ // } cs_free (x) ; cs_sfree (S) ; cs_nfree (N) ; return (ok) ; }
/** * @brief Performs LU factorization on a matrix. * * @param[in,out] lud LU factorization of the matrix. * @param[in] A Matrix to factorize. * @return 0 on success. */ static int cs_fact_init_lu( cs_fact_t *lud, const cs *A ) { int order = 2; /* order 0:natural, 1:Chol, 2:LU, 3:QR */ double tol = 1e-16; lud->S = cs_sqr( order, A, 0 ); if (lud->S == NULL) goto err_S; lud->N = cs_lu( A, lud->S, tol ); if (lud->N == NULL) goto err_N; lud->x = cs_malloc( A->n, sizeof(double) ); if (lud->x == NULL) goto err_x; lud->type = CS_FACT_LU; return 0; err_x: cs_nfree( lud->N ); err_N: cs_sfree( lud->S ); err_S: return -1; }
/* x=A\b where A is symmetric positive definite; b overwritten with solution */ CS_INT cs_cholsol (CS_INT order, const cs *A, CS_ENTRY *b) { CS_ENTRY *x ; css *S ; csn *N ; CS_INT n, ok ; if (!CS_CSC (A) || !b) return (0) ; /* check inputs */ n = A->n ; S = cs_schol (order, A) ; /* ordering and symbolic analysis */ N = cs_chol (A, S) ; /* numeric Cholesky factorization */ x = cs_malloc (n, sizeof (CS_ENTRY)) ; /* get workspace */ ok = (S && N && x) ; if (ok) { cs_ipvec (S->pinv, b, x, n) ; /* x = P*b */ cs_lsolve (N->L, x) ; /* x = L\x */ cs_ltsolve (N->L, x) ; /* x = L'\x */ cs_pvec (S->pinv, x, b, n) ; /* b = P'*x */ } cs_free (x) ; cs_sfree (S) ; cs_nfree (N) ; return (ok) ; }
void solveSparse(double time){ int i; double current_value; double *B_sparse_temp; //Adeiasma twn arxeiwn sta opoia tha apothikeutoun ta apotelesmata tis analysis gia tous komvous PLOT if(TRAN==0)initPlotFiles("Sparse"); if(ITER==0) { //LU decomposition S=cs_sqr(2,C_sparse,0); N=cs_lu(C_sparse,S,1); //cs_spfree(C_sparse); } B_sparse_temp = (double *)calloc(sizeB,sizeof(double)); //apothikeusi tou apotelesmatos tis LU solve gia to sweep kai to transient if(dc_sweep==0){ //An den exoume sweep for(i=0;i<sizeB;i++)B_sparse_temp[i]=B_sparse[i]; if (ITER == 0){ //LU solve cs_ipvec(N->pinv, B_sparse, x_sparse, sizeB); //seg fault gia choleskyNetlist!LA8OS TO N!ARA ANADROMIKA LA8OS TO C_sparse.Omws C_sparce swsto vash ths CG. cs_lsolve(N->L, x_sparse); cs_usolve(N->U, x_sparse); cs_ipvec(S->q, x_sparse, B_sparse, sizeB); //printf("\n ----- SPARSE LU decomposition ----- \n"); for(i=0;i<sizeB;i++){x_sparse[i]=B_sparse[i];} cs_nfree(N); cs_sfree(S); }else{ bi_conjugate_gradient_sparse(C_sparse,B_sparse, sizeB, x_sparse, itol_value); //printf("\n"); //printf("---- BI-CG SPARSE ----\n"); } /* printf("X = \n"); for(i=0;i<sizeB;i++){ printf(" %.6lf \n",x_sparse[i]); } printf("----------------------\n"); printf("\n"); */ if(TRAN==0){ plotFiles("Sparse", x_sparse, -1.0, "Analysis: DC"); }else{ plotFiles("Sparse", x_sparse, time, "Analysis: TRAN"); } for(i=0;i<sizeB;i++)B_sparse[i]=B_sparse_temp[i]; //epanafora tou B_sparse gia xrisi sto transient } else //DC_SWEEP != 0 { if(sweep_source!=-1){ //pigi tashs ginetai sweep for(current_value=start_value; current_value<=end_value+EPS; current_value+=sweep_step){ B_sparse[sweep_source-1]=current_value; if(ITER == 0){ cs_ipvec(N->pinv, B_sparse, x_sparse, sizeB); cs_lsolve(N->L, x_sparse); cs_usolve(N->U, x_sparse); cs_ipvec(S->q, x_sparse, B_sparse_temp, sizeB); }else{ bi_conjugate_gradient_sparse(C_sparse,B_sparse, sizeB, x_sparse, itol_value); } //Apothikeusi twn apotelesmatwn tis analysis gia tous komvous PLOT plotFiles("Sparse", (ITER ? x_sparse:B_sparse_temp), current_value, "Sweep source voltage at"); } }else{ //pigi reumatos ginetai sweep //Anairesi twn praksewn + kai - apo tin arxiki timi tis pigis ston pinaka B //kai praksi + kai - me to start_value if(sweep_posNode!=0){ B_sparse[sweep_posNode-1]+=sweep_value_I-start_value; } if(sweep_negNode!=0){ B_sparse[sweep_negNode-1]-=sweep_value_I+start_value; } for(current_value=start_value;current_value<=end_value+EPS;current_value+=sweep_step){ if(ITER == 0){ cs_ipvec(N->pinv, B_sparse, x_sparse, sizeB); cs_lsolve(N->L, x_sparse); cs_usolve(N->U, x_sparse); cs_ipvec(S->q, x_sparse, B_sparse_temp,sizeB); }else{ bi_conjugate_gradient_sparse(C_sparse,B_sparse, sizeB, x_sparse, itol_value); } //Allagi twn timwn ston pinaka B gia to epomeno vima tou sweep if(sweep_posNode!=0){ B_sparse[sweep_posNode-1]-=sweep_step; } if(sweep_negNode!=0){ B_sparse[sweep_negNode-1]+=sweep_step; } //Apothikeusi twn apotelesmatwn tis analysis gia tous komvous PLOT se arxeia plotFiles("Sparse", (ITER ? x_sparse:B_sparse_temp), current_value, "Sweep source current at"); } printf("\n"); } } free(B_sparse_temp); }
/* Cholesky update/downdate */ int demo3 (problem *Prob) { cs *A, *C, *W = NULL, *WW, *WT, *E = NULL, *W2 ; int n, k, *Li, *Lp, *Wi, *Wp, p1, p2, *p = NULL, ok ; double *b, *x, *resid, *y = NULL, *Lx, *Wx, s, t, t1 ; css *S = NULL ; csn *N = NULL ; if (!Prob || !Prob->sym || Prob->A->n == 0) return (0) ; A = Prob->A ; C = Prob->C ; b = Prob->b ; x = Prob->x ; resid = Prob->resid; n = A->n ; if (!Prob->sym || n == 0) return (1) ; rhs (x, b, n) ; /* compute right-hand side */ printf ("\nchol then update/downdate ") ; print_order (1) ; y = cs_malloc (n, sizeof (double)) ; t = tic () ; S = cs_schol (1, C) ; /* symbolic Chol, amd(A+A') */ printf ("\nsymbolic chol time %8.2f\n", toc (t)) ; t = tic () ; N = cs_chol (C, S) ; /* numeric Cholesky */ printf ("numeric chol time %8.2f\n", toc (t)) ; if (!S || !N || !y) return (done3 (0, S, N, y, W, E, p)) ; t = tic () ; cs_ipvec (S->pinv, b, y, n) ; /* y = P*b */ cs_lsolve (N->L, y) ; /* y = L\y */ cs_ltsolve (N->L, y) ; /* y = L'\y */ cs_pvec (S->pinv, y, x, n) ; /* x = P'*y */ printf ("solve chol time %8.2f\n", toc (t)) ; printf ("original: ") ; print_resid (1, C, x, b, resid) ; /* print residual */ k = n/2 ; /* construct W */ W = cs_spalloc (n, 1, n, 1, 0) ; if (!W) return (done3 (0, S, N, y, W, E, p)) ; Lp = N->L->p ; Li = N->L->i ; Lx = N->L->x ; Wp = W->p ; Wi = W->i ; Wx = W->x ; Wp [0] = 0 ; p1 = Lp [k] ; Wp [1] = Lp [k+1] - p1 ; s = Lx [p1] ; srand (1) ; for ( ; p1 < Lp [k+1] ; p1++) { p2 = p1 - Lp [k] ; Wi [p2] = Li [p1] ; Wx [p2] = s * rand () / ((double) RAND_MAX) ; } t = tic () ; ok = cs_updown (N->L, +1, W, S->parent) ; /* update: L*L'+W*W' */ t1 = toc (t) ; printf ("update: time: %8.2f\n", t1) ; if (!ok) return (done3 (0, S, N, y, W, E, p)) ; t = tic () ; cs_ipvec (S->pinv, b, y, n) ; /* y = P*b */ cs_lsolve (N->L, y) ; /* y = L\y */ cs_ltsolve (N->L, y) ; /* y = L'\y */ cs_pvec (S->pinv, y, x, n) ; /* x = P'*y */ t = toc (t) ; p = cs_pinv (S->pinv, n) ; W2 = cs_permute (W, p, NULL, 1) ; /* E = C + (P'W)*(P'W)' */ WT = cs_transpose (W2,1) ; WW = cs_multiply (W2, WT) ; cs_spfree (WT) ; cs_spfree (W2) ; E = cs_add (C, WW, 1, 1) ; cs_spfree (WW) ; if (!E || !p) return (done3 (0, S, N, y, W, E, p)) ; printf ("update: time: %8.2f (incl solve) ", t1+t) ; print_resid (1, E, x, b, resid) ; /* print residual */ cs_nfree (N) ; /* clear N */ t = tic () ; N = cs_chol (E, S) ; /* numeric Cholesky */ if (!N) return (done3 (0, S, N, y, W, E, p)) ; cs_ipvec (S->pinv, b, y, n) ; /* y = P*b */ cs_lsolve (N->L, y) ; /* y = L\y */ cs_ltsolve (N->L, y) ; /* y = L'\y */ cs_pvec (S->pinv, y, x, n) ; /* x = P'*y */ t = toc (t) ; printf ("rechol: time: %8.2f (incl solve) ", t) ; print_resid (1, E, x, b, resid) ; /* print residual */ t = tic () ; ok = cs_updown (N->L, -1, W, S->parent) ; /* downdate: L*L'-W*W' */ t1 = toc (t) ; if (!ok) return (done3 (0, S, N, y, W, E, p)) ; printf ("downdate: time: %8.2f\n", t1) ; t = tic () ; cs_ipvec (S->pinv, b, y, n) ; /* y = P*b */ cs_lsolve (N->L, y) ; /* y = L\y */ cs_ltsolve (N->L, y) ; /* y = L'\y */ cs_pvec (S->pinv, y, x, n) ; /* x = P'*y */ t = toc (t) ; printf ("downdate: time: %8.2f (incl solve) ", t1+t) ; print_resid (1, C, x, b, resid) ; /* print residual */ return (done3 (1, S, N, y, W, E, p)) ; }
CSparseCholeskyInternal::~CSparseCholeskyInternal(){ if(S_) cs_sfree(S_); if(L_) cs_nfree(L_); }
void CsparseInterface::prepare() { double time_start=0; if (CasadiOptions::profiling && CasadiOptions::profilingBinary) { time_start = getRealTime(); // Start timer profileWriteEntry(CasadiOptions::profilingLog, this); } if (!called_once_) { if (verbose()) { cout << "CsparseInterface::prepare: symbolic factorization" << endl; } // ordering and symbolic analysis int order = 0; // ordering? if (S_) cs_sfree(S_); S_ = cs_sqr(order, &A_, 0) ; } prepared_ = false; called_once_ = true; // Get a referebce to the nonzeros of the linear system const vector<double>& linsys_nz = input().data(); // Make sure that all entries of the linear system are valid for (int k=0; k<linsys_nz.size(); ++k) { casadi_assert_message(!isnan(linsys_nz[k]), "Nonzero " << k << " is not-a-number"); casadi_assert_message(!isinf(linsys_nz[k]), "Nonzero " << k << " is infinite"); } if (verbose()) { cout << "CsparseInterface::prepare: numeric factorization" << endl; cout << "linear system to be factorized = " << endl; input(0).printSparse(); } double tol = 1e-8; if (N_) cs_nfree(N_); N_ = cs_lu(&A_, S_, tol) ; // numeric LU factorization if (N_==0) { DMatrix temp = input(); temp.makeSparse(); if (temp.sparsity().isSingular()) { stringstream ss; ss << "CsparseInterface::prepare: factorization failed due to matrix" " being singular. Matrix contains numerical zeros which are " "structurally non-zero. Promoting these zeros to be structural " "zeros, the matrix was found to be structurally rank deficient." " sprank: " << sprank(temp.sparsity()) << " <-> " << temp.size2() << endl; if (verbose()) { ss << "Sparsity of the linear system: " << endl; input(LINSOL_A).sparsity().print(ss); // print detailed } throw CasadiException(ss.str()); } else { stringstream ss; ss << "CsparseInterface::prepare: factorization failed, check if Jacobian is singular" << endl; if (verbose()) { ss << "Sparsity of the linear system: " << endl; input(LINSOL_A).sparsity().print(ss); // print detailed } throw CasadiException(ss.str()); } } casadi_assert(N_!=0); prepared_ = true; if (CasadiOptions::profiling && CasadiOptions::profilingBinary) { double time_stop = getRealTime(); // Stop timer profileWriteTime(CasadiOptions::profilingLog, this, 0, time_stop-time_start, time_stop-time_start); profileWriteExit(CasadiOptions::profilingLog, this, time_stop-time_start); } }
SparseCholeskySolver<TMatrix,TVector>::~SparseCholeskySolver() { if (S) cs_sfree (S); if (N) cs_nfree (N); }
// Modified version of Tim Davis's cs_qr_mex.c file for MATLAB (in CSparse) // Usage: [V,beta,p,R,q] = cs_qr(A) ; SEXP dgCMatrix_QR(SEXP Ap, SEXP order, SEXP keep_dimnames) { CSP A = AS_CSP__(Ap), D; int io = INTEGER(order)[0]; Rboolean verbose = (io < 0);// verbose=TRUE, encoded with negative 'order' int m0 = A->m, m = m0, n = A->n, ord = asLogical(order) ? 3 : 0, *p; R_CheckStack(); if (m < n) error(_("A must have #{rows} >= #{columns}")) ; SEXP ans = PROTECT(NEW_OBJECT(MAKE_CLASS("sparseQR"))); int *dims = INTEGER(ALLOC_SLOT(ans, Matrix_DimSym, INTSXP, 2)); dims[0] = m; dims[1] = n; css *S = cs_sqr(ord, A, 1); /* symbolic QR ordering & analysis*/ if (!S) error(_("cs_sqr failed")); int keep_dimnms = asLogical(keep_dimnames); if(keep_dimnms == NA_LOGICAL) { keep_dimnms = TRUE; warning(_("dgcMatrix_QR(*, keep_dimnames = NA): NA taken as TRUE")); } if(verbose && S->m2 > m) // in ./cs.h , m2 := # of rows for QR, after adding fictitious rows Rprintf("Symbolic QR(): Matrix structurally rank deficient (m2-m = %d)\n", S->m2 - m); csn *N = cs_qr(A, S); /* numeric QR factorization */ if (!N) error(_("cs_qr failed")) ; cs_dropzeros(N->L); /* drop zeros from V and sort */ D = cs_transpose(N->L, 1); cs_spfree(N->L); N->L = cs_transpose(D, 1); cs_spfree(D); cs_dropzeros(N->U); /* drop zeros from R and sort */ D = cs_transpose(N->U, 1); cs_spfree(N->U) ; N->U = cs_transpose(D, 1); cs_spfree(D); m = N->L->m; /* m may be larger now */ // MM: m := S->m2 also counting the ficticious rows (Tim Davis, p.72, 74f) p = cs_pinv(S->pinv, m); /* p = pinv' */ SEXP dn = R_NilValue; Rboolean do_dn = FALSE; if(keep_dimnms) { dn = GET_SLOT(Ap, Matrix_DimNamesSym); do_dn = !isNull(VECTOR_ELT(dn, 0)) && m == m0; // FIXME? also deal with case m > m0 ? if(do_dn) { // keep rownames dn = PROTECT(duplicate(dn)); SET_VECTOR_ELT(dn, 1, R_NilValue); } else dn = R_NilValue; } SET_SLOT(ans, Matrix_VSym, Matrix_cs_to_SEXP(N->L, "dgCMatrix", 0, dn)); // "V" Memcpy(REAL(ALLOC_SLOT(ans, Matrix_betaSym, REALSXP, n)), N->B, n); Memcpy(INTEGER(ALLOC_SLOT(ans, Matrix_pSym, INTSXP, m)), p, m); if(do_dn) { UNPROTECT(1); // dn dn = R_NilValue; do_dn = FALSE; } if (ord) { Memcpy(INTEGER(ALLOC_SLOT(ans, install("q"), INTSXP, n)), S->q, n); if(keep_dimnms) { dn = GET_SLOT(Ap, Matrix_DimNamesSym); do_dn = !isNull(VECTOR_ELT(dn, 1)); if(do_dn) { dn = PROTECT(duplicate(dn)); // permute colnames by S->q : cn <- cn[ S->q ] : SEXP cns = PROTECT(duplicate(VECTOR_ELT(dn, 1))); for(int j=0; j < n; j++) SET_STRING_ELT(VECTOR_ELT(dn, 1), j, STRING_ELT(cns, S->q[j])); UNPROTECT(1); SET_VECTOR_ELT(dn, 0, R_NilValue); } else dn = R_NilValue; } } else ALLOC_SLOT(ans, install("q"), INTSXP, 0); SET_SLOT(ans, install("R"), Matrix_cs_to_SEXP(N->U, "dgCMatrix", 0, dn)); if(do_dn) UNPROTECT(1); // dn cs_nfree(N); cs_sfree(S); cs_free(p); UNPROTECT(1); return ans; }
/* Modified version of Tim Davis's cs_lu_mex.c file for MATLAB */ void install_lu(SEXP Ap, int order, double tol, Rboolean err_sing, Rboolean keep_dimnms) { // (order, tol) == (1, 1) by default, when called from R. SEXP ans; css *S; csn *N; int n, *p, *dims; CSP A = AS_CSP__(Ap), D; R_CheckStack(); n = A->n; if (A->m != n) error(_("LU decomposition applies only to square matrices")); if (order) { /* not using natural order */ order = (tol == 1) ? 2 /* amd(S'*S) w/dense rows or I */ : 1; /* amd (A+A'), or natural */ } S = cs_sqr(order, A, /*qr = */ 0); /* symbolic ordering */ N = cs_lu(A, S, tol); /* numeric factorization */ if (!N) { if(err_sing) error(_("cs_lu(A) failed: near-singular A (or out of memory)")); else { /* No warning: The useR should be careful : * Put NA into "LU" factor */ set_factors(Ap, ScalarLogical(NA_LOGICAL), "LU"); return; } } cs_dropzeros(N->L); /* drop zeros from L and sort it */ D = cs_transpose(N->L, 1); cs_spfree(N->L); N->L = cs_transpose(D, 1); cs_spfree(D); cs_dropzeros(N->U); /* drop zeros from U and sort it */ D = cs_transpose(N->U, 1); cs_spfree(N->U); N->U = cs_transpose(D, 1); cs_spfree(D); p = cs_pinv(N->pinv, n); /* p=pinv' */ ans = PROTECT(NEW_OBJECT(MAKE_CLASS("sparseLU"))); dims = INTEGER(ALLOC_SLOT(ans, Matrix_DimSym, INTSXP, 2)); dims[0] = n; dims[1] = n; SEXP dn; Rboolean do_dn = FALSE; if(keep_dimnms) { dn = GET_SLOT(Ap, Matrix_DimNamesSym); do_dn = !isNull(VECTOR_ELT(dn, 0)); if(do_dn) { dn = PROTECT(duplicate(dn)); // permute rownames by p : rn <- rn[ p ] : SEXP rn = PROTECT(duplicate(VECTOR_ELT(dn, 0))); for(int i=0; i < n; i++) SET_STRING_ELT(VECTOR_ELT(dn, 0), i, STRING_ELT(rn, p[i])); UNPROTECT(1); // rn SET_VECTOR_ELT(dn, 1, R_NilValue); // colnames(.) := NULL } } SET_SLOT(ans, install("L"), Matrix_cs_to_SEXP(N->L, "dtCMatrix", 0, do_dn ? dn : R_NilValue)); if(keep_dimnms) { if(do_dn) { UNPROTECT(1); // dn dn = GET_SLOT(Ap, Matrix_DimNamesSym); } do_dn = !isNull(VECTOR_ELT(dn, 1)); if(do_dn) { dn = PROTECT(duplicate(dn)); if(order) { // permute colnames by S->q : cn <- cn[ S->q ] : SEXP cn = PROTECT(duplicate(VECTOR_ELT(dn, 1))); for(int j=0; j < n; j++) SET_STRING_ELT(VECTOR_ELT(dn, 1), j, STRING_ELT(cn, S->q[j])); UNPROTECT(1); // cn } SET_VECTOR_ELT(dn, 0, R_NilValue); // rownames(.) := NULL } } SET_SLOT(ans, install("U"), Matrix_cs_to_SEXP(N->U, "dtCMatrix", 0, do_dn ? dn : R_NilValue)); if(do_dn) UNPROTECT(1); // dn Memcpy(INTEGER(ALLOC_SLOT(ans, Matrix_pSym, /* "p" */ INTSXP, n)), p, n); if (order) Memcpy(INTEGER(ALLOC_SLOT(ans, install("q"), INTSXP, n)), S->q, n); cs_nfree(N); cs_sfree(S); cs_free(p); UNPROTECT(1); set_factors(Ap, ans, "LU"); }
CsparseCholMemory::~CsparseCholMemory() { if (this->S) cs_sfree(this->S); if (this->L) cs_nfree(this->L); }
CsparseInterface::~CsparseInterface() { if (S_) cs_sfree(S_); if (N_) cs_nfree(N_); }