/* 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) ;
}
returnValue ACADOcsparse::setMatrix(double *A_)
{
int run1;
int order = 0;
if (dim <= 0)
return ACADOERROR(RET_MEMBER_NOT_INITIALISED);
if (nDense <= 0)
return ACADOERROR(RET_MEMBER_NOT_INITIALISED);
cs *C, *D;
C = cs_spalloc(0, 0, 1, 1, 1);
for (run1 = 0; run1 < nDense; run1++)
cs_entry(C, index1[run1], index2[run1], A_[run1]);
D = cs_compress(C);
S = cs_sqr(order, D, 0);
N = cs_lu(D, S, TOL);
cs_spfree(C);
cs_spfree(D);
return SUCCESSFUL_RETURN;
}
/* 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");
}
css * newton_sparsity(cs *J)
{
// Perform symbolic analysis of the Jacobian for subsequent LU
// factorisation
css *S;
int order = 0; // 0 = natural, 1 = min deg order of A + A'
S = cs_sqr(order, J, 0); // 0 means we're doing LU and not QR
return S;
}
/* 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) ;
}
int cs_lu_factorization(csi order, const cs *A, double tol, NumericsSparseLinearSolverParams* p)
{
assert(A);
assert(p);
cs_lu_factors* cs_lu_A = (cs_lu_factors*) malloc(sizeof(cs_lu_factors));
cs_lu_A->n = A->n;
css* S = cs_sqr (order, A, 0);
cs_lu_A->S = S;
cs_lu_A->N = cs_lu(A, S, tol);
p->solver_data = cs_lu_A;
return (S && cs_lu_A->N);
}
int sparse_LU_decomp(sparse_matrix* matrix, css* S, csn* N ){
if( !matrix)
return 0;
S=cs_sqr(2,matrix,0);
N=cs_lu(matrix,S,1);
if(!S || !N)
return 0;
cs_spfree(matrix);
return 1;
}
// 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;
}
/* 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) ;
}
/**
* @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;
}
/* 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;
}
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 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);
}
}
void CSparseInternal::prepare(){
if(!called_once_){
// ordering and symbolic analysis
int order = 3; // ordering?
int qr = 1; // LU
if(S_) cs_sfree(S_);
S_ = cs_sqr (order, &AT_, qr) ;
std::vector<int> pinv;
std::vector<int> q;
std::vector<int> parent;
std::vector<int> cp;
std::vector<int> leftmost;
int m2;
double lnz;
double unz;
input().sparsity()->prefactorize(order, qr, pinv, q, parent, cp, leftmost, m2, lnz, unz);
cout << "pinv" << endl;
cout << pinv << endl;
if(S_->pinv!=0)
cout << vector<int>(S_->pinv, S_->pinv + pinv.size()) << endl;
cout << endl;
cout << "q" << endl;
cout << q << endl;
if(S_->q!=0)
cout << vector<int>(S_->q, S_->q + q.size()) << endl;
cout << endl;
cout << "parent" << endl;
cout << parent << endl;
if(S_->parent!=0)
cout << vector<int>(S_->parent, S_->parent + parent.size()) << endl;
cout << endl;
cout << "cp" << endl;
cout << cp << endl;
if(S_->cp!=0)
cout << vector<int>(S_->cp, S_->cp + cp.size()) << endl;
cout << endl;
cout << "leftmost" << endl;
cout << leftmost << endl;
if(S_->leftmost!=0)
cout << vector<int>(S_->leftmost, S_->leftmost + leftmost.size()) << endl;
cout << endl;
}
prepared_ = false;
called_once_ = true;
double tol = 1e-8;
if(N_) cs_nfree(N_);
N_ = cs_lu(&AT_, S_, tol) ; // numeric LU factorization
if(N_==0){
throw CasadiException("factorization failed, Jacobian singular?");
}
casadi_assert(N_!=0);
prepared_ = true;
}
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);
}
// 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");
}
