/* 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) ; }
/** * Apply Householder transformations and the row permutation P to y * * @param a sparse matrix containing the vectors defining the * Householder transformations * @param beta scaling factors for the Householder transformations * @param y contents of a V->m by nrhs dense matrix * @param p 0-based permutation vector of length V->m * @param nrhs number of right hand sides (i.e. ncol(y)) * @param trans logical value - if TRUE create Q'y[p] otherwise Qy[p] */ static void sparseQR_Qmult(cs *V, double *beta, int *p, int trans, double *y, int *ydims) { int j, k, m = V->m, n = V->n; double *x = Alloca(m, double); /* workspace */ R_CheckStack(); if (ydims[0] != m) error(_("Dimensions of system are inconsistent")); for (j = 0; j < ydims[1]; j++) { double *yj = y + j * m; if (trans) { cs_pvec(p, yj, x, m); /* x(0:m-1) = y(p(0:m-1, j)) */ Memcpy(yj, x, m); /* replace it */ for (k = 0 ; k < n ; k++) /* apply H[1]...H[n] */ cs_happly(V, k, beta[k], yj); } else { for (k = n - 1 ; k >= 0 ; k--) /* apply H[n]...H[1] */ cs_happly(V, k, beta[k], yj); cs_ipvec(p, yj, x, m); /* inverse permutation */ Memcpy(yj, x, m); } } }
/** * @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; } }
void SparseCholeskySolver<TMatrix,TVector>::solveT(double * z, double * r) { int n = A.n; cs_ipvec (n, S->Pinv, r, (double*) &(tmp[0])); //x = P*b cs_lsolve (N->L, (double*) &(tmp[0])); //x = L\x cs_ltsolve (N->L, (double*) &(tmp[0])); //x = L'\x/ cs_pvec (n, S->Pinv, (double*) &(tmp[0]), z); //b = P'*x }
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; }
void CSparseCholeskyInternal::solve(double* x, int nrhs, bool transpose) { casadi_assert(prepared_); casadi_assert(L_!=0); double *t = &temp_.front(); for (int k=0; k<nrhs; ++k) { if (transpose) { cs_pvec(S_->q, x, t, AT_.n) ; // t = P1\b cs_ltsolve(L_->L, t) ; // t = L\t cs_lsolve(L_->L, t) ; // t = U\t cs_pvec(L_->pinv, t, x, AT_.n) ; // x = P2\t } else { cs_ipvec(L_->pinv, x, t, AT_.n) ; // t = P1\b cs_lsolve(L_->L, t) ; // t = L\t cs_ltsolve(L_->L, t) ; // t = U\t cs_ipvec(S_->q, t, x, AT_.n) ; // x = P2\t } x += ncol(); } }
void CSparseCholeskyInterface::solve(void* mem, double* x, int nrhs, bool tr) const { auto m = static_cast<CsparseCholMemory*>(mem); casadi_assert(m->L!=0); double *t = &m->temp.front(); for (int k=0; k<nrhs; ++k) { if (tr) { cs_pvec(m->S->q, x, t, m->A.n) ; // t = P1\b cs_ltsolve(m->L->L, t) ; // t = L\t cs_lsolve(m->L->L, t) ; // t = U\t cs_pvec(m->L->pinv, t, x, m->A.n) ; // x = P2\t } else { cs_ipvec(m->L->pinv, x, t, m->A.n) ; // t = P1\b cs_lsolve(m->L->L, t) ; // t = L\t cs_ltsolve(m->L->L, t) ; // t = U\t cs_ipvec(m->S->q, t, x, m->A.n) ; // x = P2\t } x += m->ncol(); } }
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(); } }
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); } }
void SparseCholeskySolver<TMatrix,TVector>::solveT(float * z, float * r) { int n = A.n; z_tmp.resize(n); r_tmp.resize(n); for (int i=0;i<n;i++) r_tmp[i] = (double) r[i]; cs_ipvec (n, S->Pinv, (double*) &(r_tmp[0]), (double*) &(tmp[0])); //x = P*b cs_lsolve (N->L, (double*) &(tmp[0])); //x = L\x cs_ltsolve (N->L, (double*) &(tmp[0])); //x = L'\x/ cs_pvec (n, S->Pinv, (double*) &(tmp[0]), (double*) &(z_tmp[0])); //b = P'*x for (int i=0;i<n;i++) z[i] = (float) z_tmp[i]; }
/* 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 choleskyDecomp_sparse(cs* matrixA, double* matrixB, double* matrixX,int size) { int i; css *S; csn *N; S=cs_schol(1, matrixA); N=cs_chol(matrixA, S); cs_spfree(matrixA); if(found_dc_sweep==0){ cs_ipvec(S->pinv, matrixB, matrixX, size); cs_lsolve(N->L, matrixX); cs_ltsolve(N->L, matrixX); cs_pvec(S->pinv, 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(S->pinv, matrixB, matrixX, size); cs_lsolve(N->L, matrixX); cs_ltsolve(N->L, matrixX); cs_pvec(S->pinv, matrixX, matrixB_temp, size); printf("value= %lf Matrix X: \n",value); for(i=0;i<size;i++){ printf(" %.6lf ",matrixX[i]); } printf("\n"); } } 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(S->pinv, matrixB, matrixX, size); cs_lsolve(N->L, matrixX); cs_ltsolve(N->L, matrixX); cs_pvec(S->pinv, matrixX, matrixB_temp, size); if (sweep_node1!=0){ matrixB[sweep_node1-1]-=step; } if(sweep_node2!=0){ matrixB[sweep_node2-1]+=step; } printf("value= %lf Matrix X: \n",value); for(i=0;i<size;i++){ printf(" %.6lf ",matrixX[i]); } printf("\n"); } } } printf("\n"); }
/* 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)) ; }
void solve_spdSparse(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){ //cholesky decomposition S=cs_schol(1, C_sparse); N=cs_chol(C_sparse, S); //cs_spfree(C_sparse); } if(dc_sweep==0){ //An den exoume sweep if(ITER==0){ cs_ipvec(S->pinv, B_sparse, x_sparse, sizeB); cs_lsolve(N->L, x_sparse); //seg fault gia choleskyNetlist!LA8OS TO N!ARA ANADROMIKA LA8OS TO C_sparse.Omws C_sparce swsto vash ths CG. cs_ltsolve(N->L, x_sparse); cs_pvec(S->pinv, x_sparse, B_sparse, sizeB); //solve cholesky for(i=0;i<sizeB;i++){ x_sparse[i]=B_sparse[i]; } //printf("\n ----- SPARSE Cholesky decomposition ----- \n"); } else{ conjugate_gradient_sparse(C_sparse,B_sparse, sizeB, x_sparse, itol_value); //solve with Conjugated Gradient //printf("\n"); //printf("---- 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"); } }else{ //An exoume sweep B_sparse_temp = (double *)calloc(sizeB,sizeof(double)); //Proswrini apothikeusi tou apotelesmatos anamesa sta loop if(sweep_source!=-1){ //pigi tasis 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(S->pinv, B_sparse, x_sparse, sizeB); cs_lsolve(N->L, x_sparse); cs_ltsolve(N->L, x_sparse); cs_pvec(S->pinv, x_sparse, B_sparse_temp, sizeB); //solve cholesky } else{ conjugate_gradient_sparse(C_sparse,B_sparse, sizeB, x_sparse, itol_value); } //Apothikeusi twn apotelesmatwn tis analysis gia tous komvous PLOT se arxeia 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(S->pinv, B_sparse, x_sparse, sizeB); cs_lsolve(N->L, x_sparse); cs_ltsolve(N->L, x_sparse); cs_pvec(S->pinv, x_sparse, B_sparse_temp, sizeB); //solve cholesky } else{ conjugate_gradient_sparse(C_sparse,B_sparse, sizeB, x_sparse, itol_value); //Arxiki proseggish h lush ths prohgoumenhs } //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"); } } }