/** * @brief Solves a sparse matrix factorization. * * This solves Ax = b. * * @param[in,out] b Input right side vector that gets set to the output solution. * @param[in] fact Factorization of the sparse matrix. */ void cs_fact_solve( double *b, cs_fact_t *fact ) { #ifdef USE_UMFPACK int ret; double info[ UMFPACK_INFO ]; int fnan, finf; #endif /* USE_UMFPACK */ int k; switch (fact->type) { case CS_FACT_CHOLESKY: cs_ipvec( fact->S->pinv, b, fact->x, fact->n ); cs_lsolve( fact->N->L, fact->x ); cs_ltsolve( fact->N->L, fact->x ); cs_pvec( fact->S->pinv, fact->x, b, fact->n ); break; case CS_FACT_LU: cs_ipvec( fact->N->pinv, b, fact->x, fact->n ); cs_lsolve( fact->N->L, fact->x ); cs_usolve( fact->N->U, fact->x ); cs_ipvec( fact->S->q, fact->x, b, fact->n ); break; case CS_FACT_QR: cs_ipvec( fact->S->pinv, b, fact->x, fact->n ); for (k=0; k<fact->n; k++) cs_happly( fact->N->L, k, fact->N->B[k], fact->x ); cs_usolve( fact->N->U, fact->x ); cs_ipvec( fact->S->q, fact->x, b, fact->n ); break; case CS_FACT_UMFPACK: #ifdef USE_UMFPACK ret = umfpack_di_wsolve( UMFPACK_A, /* Solving Ax=b problem. */ fact->A->p, fact->A->i, fact->A->x, fact->x, b, fact->numeric, NULL, info, fact->wi, fact->w ); if (ret == UMFPACK_WARNING_singular_matrix) { fprintf( stderr, "UMFPACK: wsolver Matrix singular!\n" ); fnan = 0; finf = 0; for (k=0; k<fact->n; k++) { if (isnan(fact->x[k])) { fact->x[k] = 0.; fnan = 1; } else if (isinf(fact->x[k])) { fact->x[k] = 0.; finf = 1; } } if (fnan) fprintf( stderr, "UMFPACK: NaN values detected!\n" ); if (finf) fprintf( stderr, "UMFPACK: Infinity values detected!\n" ); } memcpy( b, fact->x, fact->n*sizeof(double) ); #endif /* USE_UMFPACK */ default: break; } }
SEXP sparseQR_coef(SEXP qr, SEXP y) { SEXP ans = PROTECT(dup_mMatrix_as_dgeMatrix(y)), qslot = GET_SLOT(qr, install("q")); CSP V = AS_CSP(GET_SLOT(qr, install("V"))), R = AS_CSP(GET_SLOT(qr, install("R"))); int *ydims = INTEGER(GET_SLOT(ans, Matrix_DimSym)), *q = INTEGER(qslot), j, lq = LENGTH(qslot), m = R->m, n = R->n; double *ax = REAL(GET_SLOT(ans, Matrix_xSym)), *x = Alloca(m, double); R_CheckStack(); R_CheckStack(); /* apply row permutation and multiply by Q' */ sparseQR_Qmult(V, REAL(GET_SLOT(qr, install("beta"))), INTEGER(GET_SLOT(qr, Matrix_pSym)), 1, REAL(GET_SLOT(ans, Matrix_xSym)), ydims); for (j = 0; j < ydims[1]; j++) { double *aj = ax + j * m; cs_usolve(R, aj); if (lq) { cs_ipvec(q, aj, x, n); Memcpy(aj, x, n); } } UNPROTECT(1); return ans; }
SEXP dgCMatrix_matrix_solve(SEXP Ap, SEXP b, SEXP give_sparse) // FIXME: add 'keep_dimnames' as argument { Rboolean sparse = asLogical(give_sparse); if(sparse) { // FIXME: implement this error(_("dgCMatrix_matrix_solve(.., sparse=TRUE) not yet implemented")); /* Idea: in the for(j = 0; j < nrhs ..) loop below, build the *sparse* result matrix * ----- *column* wise -- which is perfect for dgCMatrix * --> build (i,p,x) slots "increasingly" [well, allocate in batches ..] * * --> maybe first a protoype in R */ } SEXP ans = PROTECT(dup_mMatrix_as_dgeMatrix(b)), lu, qslot; CSP L, U; int *bdims = INTEGER(GET_SLOT(ans, Matrix_DimSym)), *p, *q; int j, n = bdims[0], nrhs = bdims[1]; double *x, *ax = REAL(GET_SLOT(ans, Matrix_xSym)); C_or_Alloca_TO(x, n, double); if (isNull(lu = get_factors(Ap, "LU"))) { install_lu(Ap, /* order = */ 1, /* tol = */ 1.0, /* err_sing = */ TRUE, /* keep_dimnames = */ TRUE); lu = get_factors(Ap, "LU"); } qslot = GET_SLOT(lu, install("q")); L = AS_CSP__(GET_SLOT(lu, install("L"))); U = AS_CSP__(GET_SLOT(lu, install("U"))); R_CheckStack(); if (U->n != n) error(_("Dimensions of system to be solved are inconsistent")); if(nrhs >= 1 && n >= 1) { p = INTEGER(GET_SLOT(lu, Matrix_pSym)); q = LENGTH(qslot) ? INTEGER(qslot) : (int *) NULL; for (j = 0; j < nrhs; j++) { cs_pvec(p, ax + j * n, x, n); /* x = b(p) */ cs_lsolve(L, x); /* x = L\x */ cs_usolve(U, x); /* x = U\x */ if (q) /* r(q) = x , hence r = Q' U{^-1} L{^-1} P b = A^{-1} b */ cs_ipvec(q, x, ax + j * n, n); else Memcpy(ax + j * n, x, n); } } if(n >= SMALL_4_Alloca) Free(x); UNPROTECT(1); return ans; }
/* 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) ; }
/* x=A\b where A is unsymmetric; b overwritten with solution */ csi cs_lusol_inverse (const cs *A, double *b,double *d, csn *N, double *x) { csi n; n = A->n ; /* get workspace */ 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 (N->q, x, d, n) ; /* b(q) = x */ return (1) ; }
/* Solve Ax = b with the factorization of A stored in the cs_lu_A * This is extracted from cs_lusol, you need to synchronize any changes! */ csi cs_solve (cs_lu_factors* cs_lu_A, double* x, double *b) { assert(cs_lu_A); csi ok; csi n = cs_lu_A->n; css* S = cs_lu_A->S; csn* N = cs_lu_A->N; 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, b, n) ; /* b(q) = x */ } return (ok); }
void mexFunction ( int nargout, mxArray *pargout [ ], int nargin, const mxArray *pargin [ ] ) { cs Umatrix, Bmatrix, *U, *B, *X ; double *x, *b ; int top, nz, p, *xi ; if (nargout > 1 || nargin != 2) { mexErrMsgTxt ("Usage: x = cs_usolve(U,b)") ; } U = cs_mex_get_sparse (&Umatrix, 1, 1, pargin [0]) ; /* get U */ if (mxIsSparse (pargin [1])) { B = cs_mex_get_sparse (&Bmatrix, 0, 1, pargin [1]) ;/* get sparse b */ cs_mex_check (0, U->n, 1, 0, 1, 1, pargin [1]) ; xi = cs_malloc (2*U->n, sizeof (int)) ; /* get workspace */ x = cs_malloc (U->n, sizeof (double)) ; top = cs_spsolve (U, B, 0, xi, x, NULL, 0) ; /* x = U\b */ X = cs_spalloc (U->n, 1, U->n-top, 1, 0) ; /* create sparse x*/ X->p [0] = 0 ; nz = 0 ; for (p = top ; p < U->n ; p++) { X->i [nz] = xi [p] ; X->x [nz++] = x [xi [p]] ; } X->p [1] = nz ; pargout [0] = cs_mex_put_sparse (&X) ; cs_free (x) ; cs_free (xi) ; } else { b = cs_mex_get_double (U->n, pargin [1]) ; /* get full b */ x = cs_mex_put_double (U->n, b, &(pargout [0])) ; /* x = b */ cs_usolve (U, x) ; /* x = U\x */ } }
int lusoln(ode_workspace *odews, double *b) { // Can only be called if newton_matrix has been called already double *x; int n = odews->W->J->n; x = cs_malloc (n, sizeof (*x)); int ok = odews->S && odews->N && x; if (ok) { cs_ipvec(odews->N->pinv, b, x, n); cs_lsolve(odews->N->L, x); cs_usolve(odews->N->U, x); cs_ipvec(odews->S->q, x, b, n); } cs_free (x); return ok; }
returnValue ACADOcsparse::solve(double *b) { // CONSISTENCY CHECKS: // ------------------- if (dim <= 0) return ACADOERROR(RET_MEMBER_NOT_INITIALISED); if (nDense <= 0) return ACADOERROR(RET_MEMBER_NOT_INITIALISED); if (S == 0) return ACADOERROR(RET_MEMBER_NOT_INITIALISED); // CASE: LU cs_ipvec(N->pinv, b, x, dim); /* x = b(p) */ cs_lsolve(N->L, x); /* x = L\x */ cs_usolve(N->U, x); /* x = U\x */ cs_ipvec(S->q, x, b, dim); /* b(q) = x */ return SUCCESSFUL_RETURN; }
void CSparseInternal::solve(double* x, int nrhs, bool transpose){ casadi_assert(prepared_); casadi_assert(N_!=0); double *t = &temp_.front(); for(int k=0; k<nrhs; ++k){ if(transpose){ cs_ipvec (N_->pinv, x, t, AT_.n) ; // t = P1\b cs_lsolve (N_->L, t) ; // t = L\t cs_usolve (N_->U, t) ; // t = U\t cs_ipvec (S_->q, t, x, AT_.n) ; // x = P2\t } else { cs_pvec (S_->q, x, t, AT_.n) ; // t = P2*b casadi_assert(N_->U!=0); cs_utsolve (N_->U, t) ; // t = U'\t cs_ltsolve (N_->L, t) ; // t = L'\t cs_pvec (N_->pinv, t, x, AT_.n) ; // x = P1*t } x += nrow(); } }
SEXP dtCMatrix_matrix_solve(SEXP a, SEXP b, SEXP classed) { int cl = asLogical(classed); SEXP ans = PROTECT(NEW_OBJECT(MAKE_CLASS("dgeMatrix"))); CSP A = AS_CSP(a); int *adims = INTEGER(GET_SLOT(a, Matrix_DimSym)), *bdims = INTEGER(cl ? GET_SLOT(b, Matrix_DimSym) : getAttrib(b, R_DimSymbol)); int j, n = bdims[0], nrhs = bdims[1], lo = (*uplo_P(a) == 'L'); double *bx; R_CheckStack(); if (*adims != n || nrhs < 1 || *adims < 1 || *adims != adims[1]) error(_("Dimensions of system to be solved are inconsistent")); Memcpy(INTEGER(ALLOC_SLOT(ans, Matrix_DimSym, INTSXP, 2)), bdims, 2); /* FIXME: copy dimnames or Dimnames as well */ bx = Memcpy(REAL(ALLOC_SLOT(ans, Matrix_xSym, REALSXP, n * nrhs)), REAL(cl ? GET_SLOT(b, Matrix_xSym):b), n * nrhs); for (j = 0; j < nrhs; j++) lo ? cs_lsolve(A, bx + n * j) : cs_usolve(A, bx + n * j); UNPROTECT(1); return ans; }
void CsparseInterface::solve(double* x, int nrhs, bool transpose) { double time_start=0; if (CasadiOptions::profiling&& CasadiOptions::profilingBinary) { time_start = getRealTime(); // Start timer profileWriteEntry(CasadiOptions::profilingLog, this); } casadi_assert(prepared_); casadi_assert(N_!=0); double *t = &temp_.front(); for (int k=0; k<nrhs; ++k) { if (transpose) { cs_pvec(S_->q, x, t, A_.n) ; // t = P2*b casadi_assert(N_->U!=0); cs_utsolve(N_->U, t) ; // t = U'\t cs_ltsolve(N_->L, t) ; // t = L'\t cs_pvec(N_->pinv, t, x, A_.n) ; // x = P1*t } else { cs_ipvec(N_->pinv, x, t, A_.n) ; // t = P1\b cs_lsolve(N_->L, t) ; // t = L\t cs_usolve(N_->U, t) ; // t = U\t cs_ipvec(S_->q, t, x, A_.n) ; // x = P2\t } x += ncol(); } if (CasadiOptions::profiling && CasadiOptions::profilingBinary) { double time_stop = getRealTime(); // Stop timer profileWriteTime(CasadiOptions::profilingLog, this, 1, time_stop-time_start, time_stop-time_start); profileWriteExit(CasadiOptions::profilingLog, this, time_stop-time_start); } }
/* 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) ; }
void luDecomp_sparse(cs* matrixA, double* matrixB, double* matrixX, int size) { int i; css *S; csn *N; S=cs_sqr(2,matrixA,0); N=cs_lu(matrixA,S,1); cs_spfree(matrixA); if(found_dc_sweep==0){ cs_ipvec(N->pinv, matrixB, matrixX, size); cs_lsolve(N->L, matrixX); cs_usolve(N->U, matrixX); cs_ipvec(S->q, matrixX, matrixB, size); printf("X vector \n"); for(i=0;i<size;i++){ printf(" %.6lf ",matrixX[i]); } printf("\n"); } else{ double value; double *matrixB_temp = (double *)calloc(size,sizeof(double)); if (source > -1) { for(value=start_value;value<=end_value;value=value+step){ matrixB[source-1]=value; cs_ipvec(N->pinv, matrixB, matrixX, size); cs_lsolve(N->L, matrixX); cs_usolve(N->U, matrixX); } } else { if (sweep_node1!=0){ matrixB[sweep_node1-1]+=sweep_value-start_value; } if(sweep_node2!=0){ matrixB[sweep_node2-1]-=sweep_value+start_value; } for(value=start_value;value<=end_value;value=value+step) { cs_ipvec(N->pinv, matrixB, matrixX, size); cs_lsolve(N->L, matrixX); cs_usolve(N->U, matrixX); cs_ipvec(S->q, matrixX, matrixB_temp, size); if (sweep_node1!=0){ matrixB[sweep_node1-1]+=sweep_value-start_value; } if(sweep_node2!=0){ matrixB[sweep_node2-1]-=sweep_value+start_value; } printf("value= %lf Matrix X: \n",value); for(i=0;i<size;i++){ printf(" %.6lf ",matrixX[i]); } printf("\n"); } } } printf("\n"); }
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); }