CSparseMatrix* NM_triplet_to_csr(CSparseMatrix* triplet)
{
#ifdef WITH_MKL_SPBLAS
assert(triplet);
CHECK_MKL(load_mkl_function("mkl_dcsrcoo", (void**)&mkl_dcsrcoo_p));
if (triplet->m != triplet->n)
{
fprintf(stderr, "NM_triplet_to_csr :: the matrix has to be square\n");
exit(EXIT_FAILURE);
}
CSparseMatrix* csr = cs_spalloc(NSM_NROW_CSR(triplet), NSM_NCOL_CSR(triplet), triplet->nz, 1, 0);
assert(csr);
csr->nz = -2;
CS_INT n = csr->n;
CS_INT job[6] = {0};
CS_INT info = 0;
job[0] = 2;
(*mkl_dcsrcoo_p)(job, &n, csr->x, csr->i, csr->p, &(triplet->nz), triplet->x, triplet->i, triplet->p, &info);
return csr;
#else
fprintf(stderr, "NM_triplet_to_csr :: MKL not enabled\n");
exit(EXIT_FAILURE);
#endif
}
/**
* @brief Creates the penalty matrix D tilde of order k.
* Returns the matrix Dk premultipied by a diagonal
* matrix of weights.
*
* @param n number of observations
* @param k order of the trendfilter
* @param x locations of the responses
* @return pointer to a csparse matrix
* @see tf_calc_dktil
*/
cs * tf_calc_dktil (int n, int k, const double * x)
{
cs * delta_k;
cs * delta_k_cp;
cs * Dk;
cs * Dktil;
int i;
Dk = tf_calc_dk(n, k, x);
/* Deal with k=0 separately */
if(k == 0)
return Dk;
/* Construct diagonal matrix of differences: */
delta_k = cs_spalloc(n-k, n-k, (n-k), 1, 1);
for(i = 0; i < n - k; i++)
{
delta_k->p[i] = i;
delta_k->i[i] = i;
delta_k->x[i] = k / (x[k + i] - x[i]);
}
delta_k->nz = n-k;
delta_k_cp = cs_compress(delta_k);
Dktil = cs_multiply(delta_k_cp, Dk);
cs_spfree(Dk);
cs_spfree(delta_k);
cs_spfree(delta_k_cp);
return Dktil;
}
CSparseMatrix* NM_csr_to_csc(CSparseMatrix* csr)
{
#ifdef WITH_MKL_SPBLAS
assert(csr);
CHECK_MKL(load_mkl_function("mkl_dcsrcsc", (void**)&mkl_dcsrcsc_p));
if (csr->m != csr->n)
{
fprintf(stderr, "NM_csr_to_csc :: the matrix has to be square\n");
exit(EXIT_FAILURE);
}
assert(csr);
CSparseMatrix* csc = cs_spalloc(csr->m, csr->n, csr->nzmax, 1, 0);
assert(csc);
CS_INT n = csr->n;
CS_INT job[6] = {0};
job[5] = 1;
CS_INT info = 0;
(*mkl_dcsrcsc_p)(job, &n, csr->x, csr->i, csr->p, csc->x, csc->i, csc->p, &info);
return csc;
#else
fprintf(stderr, "NM_csr_to_csc :: MKL not enabled\n");
exit(EXIT_FAILURE);
#endif
}
CSparseMatrix* NM_csr_to_triplet(CSparseMatrix* csr)
{
#ifdef WITH_MKL_SPBLAS
assert(csr);
CHECK_MKL(load_mkl_function("mkl_dcsrcoo", (void**)&mkl_dcsrcoo_p));
if (csr->m != csr->n)
{
fprintf(stderr, "NM_csr_to_triplet :: the matrix has to be square\n");
exit(EXIT_FAILURE);
}
CSparseMatrix* triplet = cs_spalloc(csr->m, csr->n, csr->p[csr->m], 1, 1);
assert(triplet);
CS_INT n = csr->n;
CS_INT job[6] = {0};
job[4] = csr->p[csr->m];
job[5] = 3;
CS_INT info = 0;
(*mkl_dcsrcoo_p)(job, &n, csr->x, csr->i, csr->p, &(csr->p[csr->m]), triplet->x, triplet->i, triplet->p, &info);
triplet->nz = csr->p[csr->m];
return triplet;
#else
fprintf(stderr, "NM_csr_to_triplet :: MKL not enabled\n");
exit(EXIT_FAILURE);
#endif
}
/* Calculates A*b + D (identity), for a square matrix
A and scalar b */
cs * scalar_plus_diag (const cs * A, double b, double *D)
{
int i;
int j;
cs * B;
B = cs_spalloc(A->m, A->n, A->nzmax, 1, 0);
for (j = 0; j < A->n; j++)
{
B->p[j] = A->p[j];
for (i = A->p[j] ; i < A->p[j+1] ; i++)
{
if(A->i[i] == j)
{
B->x[i] = b * A->x[i] + D[j];
} else {
B->x[i] = b * A->x[i];
}
B->i[i] = A->i[i];
}
}
B->p[j] = A->p[j];
return B;
}
cs *cs_compress(const cs *T) {
int m, n, nz, p, k, *Cp, *Ci, *w, *Ti, *Tj;
double *Cx, *Tx;
cs *C;
if (!CS_TRIPLET (T))
return (NULL); /* check inputs */
m = T->m;
n = T->n;
Ti = T->i;
Tj = T->p;
Tx = T->x;
nz = T->nz;
C = cs_spalloc(m, n, nz, Tx != NULL, 0); /* allocate result */
w = (int *) cs_calloc(n, sizeof(int)); /* get workspace */
if (!C || !w)
return (cs_done(C, w, NULL, 0)); /* out of memory */
Cp = C->p;
Ci = C->i;
Cx = C->x;
for (k = 0; k < nz; k++)
w[Tj[k]]++; /* column counts */
cs_cumsum(Cp, w, n); /* column pointers */
for (k = 0; k < nz; k++) {
Ci[p = w[Tj[k]]++] = Ti[k]; /* A(i,j) is the pth entry in C */
if (Cx)
Cx[p] = Tx[k];
}
return (cs_done(C, w, NULL, 1)); /* success; free w and return C */
}
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;
}
cs *cs_transpose(const cs *A, int values) {
int p, q, j, *Cp, *Ci, n, m, *Ap, *Ai, *w;
double *Cx, *Ax;
cs *C;
if (!CS_CSC (A))
return (NULL); /* check inputs */
m = A->m;
n = A->n;
Ap = A->p;
Ai = A->i;
Ax = A->x;
C = cs_spalloc(n, m, Ap[n], values && Ax, 0); /* allocate result */
w = (int *) cs_calloc(m, sizeof(int)); /* get workspace */
if (!C || !w)
return (cs_done(C, w, NULL, 0)); /* out of memory */
Cp = C->p;
Ci = C->i;
Cx = C->x;
for (p = 0; p < Ap[n]; p++)
w[Ai[p]]++; /* row counts */
cs_cumsum(Cp, w, m); /* row pointers */
for (j = 0; j < n; j++) {
for (p = Ap[j]; p < Ap[j + 1]; p++) {
Ci[q = w[Ai[p]]++] = j; /* place A(i,j) as entry C(j,i) */
if (Cx)
Cx[q] = Ax[p];
}
}
return (cs_done(C, w, NULL, 1)); /* success; free w and return C */
}
/* C = A*B */
cs *cs_multiply (const cs *A, const cs *B)
{
CS_INT p, j, nz = 0, anz, *Cp, *Ci, *Bp, m, n, bnz, *w, values, *Bi ;
CS_ENTRY *x, *Bx, *Cx ;
cs *C ;
if (!CS_CSC (A) || !CS_CSC (B)) return (NULL) ; /* check inputs */
if (A->n != B->m) return (NULL) ;
m = A->m ; anz = A->p [A->n] ;
n = B->n ; Bp = B->p ; Bi = B->i ; Bx = B->x ; bnz = Bp [n] ;
w = cs_calloc (m, sizeof (CS_INT)) ; /* get workspace */
values = (A->x != NULL) && (Bx != NULL) ;
x = values ? cs_malloc (m, sizeof (CS_ENTRY)) : NULL ; /* get workspace */
C = cs_spalloc (m, n, anz + bnz, values, 0) ; /* allocate result */
if (!C || !w || (values && !x)) return (cs_done (C, w, x, 0)) ;
Cp = C->p ;
for (j = 0 ; j < n ; j++)
{
if (nz + m > C->nzmax && !cs_sprealloc (C, 2*(C->nzmax)+m))
{
return (cs_done (C, w, x, 0)) ; /* out of memory */
}
Ci = C->i ; Cx = C->x ; /* C->i and C->x may be reallocated */
Cp [j] = nz ; /* column j of C starts here */
for (p = Bp [j] ; p < Bp [j+1] ; p++)
{
nz = cs_scatter (A, Bi [p], Bx ? Bx [p] : 1, w, x, j+1, C, nz) ;
}
if (values) for (p = Cp [j] ; p < nz ; p++) Cx [p] = x [Ci [p]] ;
}
Cp [n] = nz ; /* finalize the last column of C */
cs_sprealloc (C, 0) ; /* remove extra space from C */
return (cs_done (C, w, x, 1)) ; /* success; free workspace, return C */
}
cs *cs_rR(const cs *A, double nu, double nuR, const css *As, const cs *Roldinv, double Roldldet, const cs *pG){
cs *Rnew, *Rnewinv, *Ainv;
double Rnewldet, MH;
int dimG = A->n;
int cnt = 0;
int i, j;
Rnewinv = cs_spalloc (dimG, dimG, dimG*dimG, 1, 0);
for (i = 0 ; i < dimG; i++){
Rnewinv->p[i] = i*dimG;
for (j = 0 ; j < dimG; j++){
Rnewinv->i[cnt] = j;
Rnewinv->x[cnt] = 0.0;
A->x[i*dimG+j] -= pG->x[i*dimG+j];
cnt++;
}
}
Rnewinv->p[dimG] = dimG*dimG;
cs_cov2cor(A);
Ainv = cs_inv(A);
Rnew = cs_rinvwishart(Ainv, nu, As);
cs_cov2cor(Rnew);
Rnewldet = log(cs_invR(Rnew, Rnewinv));
/*****************************************************/
/* From Eq A.4 in Liu and Daniels (2006) */
/* using \pi_{1} = Eq 6 in Barnard (2000) */
/* using \pi_{2} = Eq 3.4 in Liu and Daniels (2006) */
/*****************************************************/
MH = Roldldet-Rnewldet;
for (i = 0 ; i < dimG; i++){
MH += log(Roldinv->x[i*dimG+i]);
MH -= log(Rnewinv->x[i*dimG+i]);
}
MH *= 0.5*nuR;
if(MH<log(runif(0.0,1.0)) || Rnewldet<log(Dtol)){
Rnewldet = cs_invR(Roldinv, Rnew); // save old R
}
for (i = 0 ; i < dimG; i++){
for (j = 0 ; j < dimG; j++){
Rnew->x[i*dimG+j] *= sqrt((pG->x[i*dimG+i])*(pG->x[j*dimG+j]));
}
}
cs_spfree(Rnewinv);
cs_spfree(Ainv);
return (cs_done (Rnew, NULL, NULL, 1)) ; /* success; free workspace, return C */
}
/* C = alpha*A + beta*B */
cs *cs_add (const cs *A, const cs *B, double alpha, double beta)
{
int p, j, nz = 0, anz, *Cp, *Ci, *Bp, m, n, bnz, *w, values ;
double *x, *Bx, *Cx ;
cs *C ;
if (!CS_CSC (A) || !CS_CSC (B)) return (NULL) ; /* check inputs */
if (A->m != B->m || A->n != B->n) return (NULL) ;
m = A->m ; anz = A->p [A->n] ;
n = B->n ; Bp = B->p ; Bx = B->x ; bnz = Bp [n] ;
w = cs_calloc (m, sizeof (int)) ; /* get workspace */
values = (A->x != NULL) && (Bx != NULL) ;
x = values ? cs_malloc (m, sizeof (double)) : NULL ; /* get workspace */
C = cs_spalloc (m, n, anz + bnz, values, 0) ; /* allocate result*/
if (!C || !w || (values && !x)) return (cs_done (C, w, x, 0)) ;
Cp = C->p ; Ci = C->i ; Cx = C->x ;
for (j = 0 ; j < n ; j++)
{
Cp [j] = nz ; /* column j of C starts here */
nz = cs_scatter (A, j, alpha, w, x, j+1, C, nz) ; /* alpha*A(:,j)*/
nz = cs_scatter (B, j, beta, w, x, j+1, C, nz) ; /* beta*B(:,j) */
if (values) for (p = Cp [j] ; p < nz ; p++) Cx [p] = x [Ci [p]] ;
}
Cp [n] = nz ; /* finalize the last column of C */
cs_sprealloc (C, 0) ; /* remove extra space from C */
return (cs_done (C, w, x, 1)) ; /* success; free workspace, return C */
}
void ppp_copy(cs * to, cs const * from)
{
int j;
if(!CS_CSC(to) || !CS_CSC(from)) REPORT_ERR(PPP_EOP);
if(to->n != from->n || to->m != from->m) REPORT_ERR(PPP_EOP);
cs * zero = cs_spalloc(from->m, from->n, 0, 1, 0);
for(j=0;j<=zero->n;++j)
zero->p[j] = 0;
ppp_add(to, from, zero, 1);
cs_spfree(zero);
}
/**
* @brief Creates the admittance matrix.
*
* @return 0 on success.
*/
static int econ_createGMatrix (void)
{
int ret;
int i, j;
double R, Rsum;
cs *M;
StarSystem *sys;
/* Create the matrix. */
M = cs_spalloc( systems_nstack, systems_nstack, 1, 1, 1 );
if (M == NULL)
ERR("Unable to create CSparse Matrix.");
/* Fill the matrix. */
for (i=0; i < systems_nstack; i++) {
sys = &systems_stack[i];
Rsum = 0.;
/* Set some values. */
for (j=0; j < sys->njumps; j++) {
/* Get the resistances. */
R = econ_calcJumpR( sys, &systems_stack[sys->jumps[j]] );
R = 1./R; /* Must be inverted. */
Rsum += R;
/* Matrix is symetrical and non-diagonal is negative. */
ret = cs_entry( M, i, sys->jumps[j], -R );
if (ret != 1)
WARN("Unable to enter CSparse Matrix Cell.");
ret = cs_entry( M, sys->jumps[j], i, -R );
if (ret != 1)
WARN("Unable to enter CSparse Matrix Cell.");
}
/* Set the diagonal. */
Rsum += 1./ECON_SELF_RES; /* We add a resistence for dampening. */
cs_entry( M, i, i, Rsum );
}
/* Compress M matrix and put into G. */
if (econ_G != NULL)
cs_spfree( econ_G );
econ_G = cs_compress( M );
if (econ_G == NULL)
ERR("Unable to create economy G Matrix.");
/* Clean up. */
cs_spfree(M);
return 0;
}
/* load a triplet matrix from a file */
cs *cs_load (FILE *f)
{
int i, j ;
double x ;
cs *T ;
if (!f) return (NULL) ; /* check inputs */
T = cs_spalloc (0, 0, 1, 1, 1) ; /* allocate result */
while (fscanf (f, "%d %d %lg\n", &i, &j, &x) == 3)
{
if (!cs_entry (T, i, j, x)) return (cs_spfree (T)) ;
}
return (T) ;
}
/* cs_updown: sparse Cholesky update/downdate (rank-1 or multiple rank) */
void mexFunction
(
int nargout,
mxArray *pargout [ ],
int nargin,
const mxArray *pargin [ ]
)
{
cs Lmatrix, *Lin, Cmatrix, *C, *L, Cvector, *Cvec ;
int ignore, j, k, n, lnz, *parent, sigma = 1, cp [2] ;
char sigma_string [20] ;
if (nargout > 1 || nargin < 3 || nargin > 4)
{
mexErrMsgTxt ("Usage: L = cs_updown(L,C,parent,sigma)") ;
}
Lin = cs_mex_get_sparse (&Lmatrix, 1, 1, pargin [0]) ; /* get input L */
n = Lin->n ;
if (nargin > 3 && mxIsChar (pargin [3]))
{
mxGetString (pargin [3], sigma_string, 8) ;
sigma = (sigma_string [0] == '-') ? (-1) : 1 ;
}
/* make a copy of L (this can take more work than updating L itself) */
lnz = Lin->p [n] ;
L = cs_spalloc (n, n, lnz, 1, 0) ;
for (j = 0 ; j <= n ; j++) L->p [j] = Lin->p [j] ;
for (k = 0 ; k < lnz ; k++) L->i [k] = Lin->i [k] ;
for (k = 0 ; k < lnz ; k++) L->x [k] = Lin->x [k] ;
cs_mex_check (0, n, -1, 0, 1, 1, pargin [1]) ; /* get C */
C = cs_mex_get_sparse (&Cmatrix, 0, 1, pargin [1]) ;
parent = cs_mex_get_int (n, pargin [2], &ignore, 0) ; /* get parent */
/* do the update one column at a time */
Cvec = &Cvector ;
Cvec->m = n ;
Cvec->n = 1 ;
Cvec->p = cp ;
Cvec->nz = -1 ;
cp [0] = 0 ;
for (k = 0 ; k < C->n ; k++)
{
/* extract C(:,k) */
cp [1] = C->p [k+1] - C->p [k] ;
Cvec->nzmax = cp [1] ;
Cvec->i = C->i + C->p [k] ;
Cvec->x = C->x + C->p [k] ;
cs_updown (L, sigma, Cvec, parent) ; /* update/downdate */
}
pargout [0] = cs_mex_put_sparse (&L) ; /* return new L */
}
cs * formKKT(const AMatrix * A, const Settings * s) {
/* ONLY UPPER TRIANGULAR PART IS STUFFED
* forms column compressed KKT matrix
* assumes column compressed form A matrix
*
* forms upper triangular part of [I A'; A -I]
*/
scs_int j, k, kk;
cs * K_cs;
/* I at top left */
const scs_int Anz = A->p[A->n];
const scs_int Knzmax = A->n + A->m + Anz;
cs * K = cs_spalloc(A->m + A->n, A->m + A->n, Knzmax, 1, 1);
#if EXTRAVERBOSE > 0
scs_printf("forming KKT\n");
#endif
if (!K) {
return NULL;
}
kk = 0;
for (k = 0; k < A->n; k++) {
K->i[kk] = k;
K->p[kk] = k;
K->x[kk] = s->rho_x;
kk++;
}
/* A^T at top right : CCS: */
for (j = 0; j < A->n; j++) {
for (k = A->p[j]; k < A->p[j + 1]; k++) {
K->p[kk] = A->i[k] + A->n;
K->i[kk] = j;
K->x[kk] = A->x[k];
kk++;
}
}
/* -I at bottom right */
for (k = 0; k < A->m; k++) {
K->i[kk] = k + A->n;
K->p[kk] = k + A->n;
K->x[kk] = -1;
kk++;
}
/* assert kk == Knzmax */
K->nz = Knzmax;
K_cs = cs_compress(K);
cs_spfree(K);
return (K_cs);
}
/* create an empty triplet matrix, insert 2 elements, print and free */
int main()
{
CSparseMatrix *m = cs_spalloc(0,0,0,0,1); /* coo format */
int info1 = 1-cs_entry(m, 3, 4, 1.0);
int info2 = 1-cs_entry(m, 1, 2, 2.0);
int info3 = 1-cs_print(m, 0);
m=cs_spfree(m);
int info4 = 1-(m==NULL);
return info1+info2+info3+info4;
}
CSparseMatrix* NM_csc_to_triplet(CSparseMatrix* csc)
{
assert(csc);
CSparseMatrix* triplet = cs_spalloc(csc->m, csc->n, csc->p[csc->n], 1, 1);
CS_INT* Ap = csc->p;
CS_INT* Ai = csc->i;
double* val = csc->x;
for (CS_INT j = 0; j < csc->n; ++j)
{
for (CS_INT i = Ap[j]; i < Ap[j+1]; ++i)
{
CSparseMatrix_zentry(triplet, Ai[i], j, val[i]);
}
}
return triplet;
}
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 *cs_symperm(const cs *A, const int *pinv, int values) {
int i, j, p, q, i2, j2, n, *Ap, *Ai, *Cp, *Ci, *w;
double *Cx, *Ax;
cs *C;
if (!CS_CSC (A))
return (NULL); /* check inputs */
n = A->n;
Ap = A->p;
Ai = A->i;
Ax = A->x;
C = cs_spalloc(n, n, Ap[n], values && (Ax != NULL), 0); /* alloc result*/
w = (int *) cs_calloc(n, sizeof(int)); /* get workspace */
if (!C || !w)
return (cs_done(C, w, NULL, 0)); /* out of memory */
Cp = C->p;
Ci = C->i;
Cx = C->x;
for (j = 0; j < n; j++) /* count entries in each column of C */
{
j2 = pinv ? pinv[j] : j; /* column j of A is column j2 of C */
for (p = Ap[j]; p < Ap[j + 1]; p++) {
i = Ai[p];
if (i > j)
continue; /* skip lower triangular part of A */
i2 = pinv ? pinv[i] : i; /* row i of A is row i2 of C */
w[CS_MAX (i2, j2)]++; /* column count of C */
}
}
cs_cumsum(Cp, w, n); /* compute column pointers of C */
for (j = 0; j < n; j++) {
j2 = pinv ? pinv[j] : j; /* column j of A is column j2 of C */
for (p = Ap[j]; p < Ap[j + 1]; p++) {
i = Ai[p];
if (i > j)
continue; /* skip lower triangular part of A*/
i2 = pinv ? pinv[i] : i; /* row i of A is row i2 of C */
Ci[q = w[CS_MAX (i2, j2)]++] = CS_MIN (i2, j2);
if (Cx)
Cx[q] = Ax[p];
}
}
return (cs_done(C, w, NULL, 1)); /* success; free workspace, return C */
}
void NM_copy_to_sparse(const NumericsMatrix* const A, NumericsMatrix* B)
{
assert(A);
assert(B);
B->size0 = A->size0;
B->size1 = A->size1;
assert(B->storageType == NM_SPARSE);
if (!B->matrix2)
{
B->matrix2 = newNumericsSparseMatrix();
}
switch (A->storageType)
{
case NM_DENSE:
{
B->matrix2->triplet = cs_spalloc(0,0,1,1,1);
NM_dense_to_sparse(A, B);
break;
}
case NM_SPARSE_BLOCK:
{
// XXX this is suboptimal since the matrix A might have already been converted
// to csc or triplet --xhub
B->matrix1 = A->matrix1;
B->storageType = NM_SPARSE_BLOCK;
NM_triplet(B);
B->matrix1 = NULL;
B->storageType = NM_SPARSE;
break;
}
case NM_SPARSE:
{
NM_copy(A, B);
break;
}
default:
{
printf("NM_copy_to_sparse :: Unsupported storage type %d, exiting!\n", A->storageType);
exit(EXIT_FAILURE);
}
}
}
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 */
}
}
cs *cs_load(char *matrixFilename) {
double i, j; /* use double for integers to avoid csi conflicts */
double x;
cs *T;
FILE *matrixFilePtr;
matrixFilePtr = fopen(matrixFilename, "r");
if (matrixFilePtr == NULL) {
fprintf(stderr, "Could not open output file %s for writing\n", matrixFilename);
exit(EXIT_FAILURE);
}
T = cs_spalloc(0, 0, 1, 1, 1); /* allocate result */
while (fscanf(matrixFilePtr, "%lg %lg %lg\n", &i, &j, &x) == 3) {
if (!cs_entry(T, i, j, x))
return (cs_spfree(T));
}
return (T);
}
cs* NN_subColumns_sp(cs* A, int c_left, int c_right)
{
csi j,p,*Ap,*Ai;
double *Ax;
cs *T,*ret;
Ap = A->p;
Ai = A->i;
Ax = A->x;
if (!A) return (NULL) ; /* check inputs */
T = cs_spalloc (0, 0, 1, 1, 1) ; /* allocate result */
for(j=c_left; j<=c_right; j++) {
for(p=Ap[j]; p<Ap[j+1]; p++) {
if(!cs_entry(T, Ai[p], j-c_left, Ax[p])) return (cs_spfree(T));
}
}
cs_entry(T,A->m-1,c_right-c_left,0.0);
ret = cs_compress(T);
cs_spfree(T);
return ret;
}
void test_ppp_add(char const * A_file, char const * B_file, char const * C_file)
{
cs * A = ppp_load_ccf(A_file);
cs * B = ppp_load_ccf(B_file);
cs *C = NULL, *D = NULL;
if(C_file)
C = ppp_load_ccf(C_file);
cs * R = cs_spalloc(A->m, A->n, A->p[A->n] + B->p[B->n], 1, 0); /* allocate result*/
csi mn = A->n > A->m ? A->n : A->m;
ppp_init_cs(mn);
ppp_add(R, A, B, 1);
/* Test equivalence */
if(C_file){
D = cs_add(C,R,1,-1);
if(cs_norm(D) > cs_norm(C) * PPP_EPSILON){
fprintf(stderr, "Diff found [%s + %s != %s]:\n", A_file, B_file, C_file);
fprintf(stdout, "Diff found [%s + %s != %s]:\n", A_file, B_file, C_file);
fprintf(stdout, "Expected:\n");
cs_print(C,0);
fprintf(stdout, "Obtained:\n");
cs_print(R,0);
fprintf(stdout, "Diff:\n");
cs_print(D,0);
}else{
fprintf(stdout, "Success!\n");
}
}
/* clean up*/
cs_spfree(A);
cs_spfree(B);
cs_spfree(C);
cs_spfree(R);
cs_spfree(D);
ppp_done();
}
cs *cs_permute (const cs *A, const int *pinv, const int *q, int values)
{
int t, j, k, nz = 0, m, n, *Ap, *Ai, *Cp, *Ci ;
double *Cx, *Ax ;
cs *C ;
if (!CS_CSC (A)) return (NULL) ; /* check inputs */
m = A->m ; n = A->n ; Ap = A->p ; Ai = A->i ; Ax = A->x ;
C = cs_spalloc (m, n, Ap [n], values && Ax != NULL, 0) ; /* alloc result */
if (!C) return (cs_done (C, NULL, NULL, 0)) ; /* out of memory */
Cp = C->p ; Ci = C->i ; Cx = C->x ;
for (k = 0 ; k < n ; k++)
{
Cp [k] = nz ; /* column k of C is column q[k] of A */
j = q ? (q [k]) : k ;
for (t = Ap [j] ; t < Ap [j+1] ; t++)
{
if (Cx) Cx [nz] = Ax [t] ; /* row i of A is row pinv[i] of C */
Ci [nz++] = pinv ? (pinv [Ai [t]]) : Ai [t] ;
}
}
Cp [n] = nz ; /* finalize the last column of C */
return (cs_done (C, NULL, NULL, 1)) ;
}
/* cs_droptol: remove small entries from A */
void mexFunction
(
int nargout,
mxArray *pargout [ ],
int nargin,
const mxArray *pargin [ ]
)
{
cs Amatrix, *C, *A ;
int j, k ;
double tol ;
if (nargout > 1 || nargin != 2)
{
mexErrMsgTxt ("Usage: C = cs_droptol(A,tol)") ;
}
A = cs_mex_get_sparse (&Amatrix, 0, 1, pargin [0]) ; /* get A */
tol = mxGetScalar (pargin [1]) ; /* get tol */
C = cs_spalloc (A->m, A->n, A->nzmax, 1, 0) ; /* C = A */
for (j = 0 ; j <= A->n ; j++) C->p [j] = A->p [j] ;
for (k = 0 ; k < A->nzmax ; k++) C->i [k] = A->i [k] ;
for (k = 0 ; k < A->nzmax ; k++) C->x [k] = A->x [k] ;
cs_droptol (C, tol) ; /* drop from C */
pargout [0] = cs_mex_put_sparse (&C) ; /* return C */
}
static
cs *cs_frand (csi n, csi nel, csi s)
{
csi ss = s*s, nz = nel*ss, e, i, j, *P ;
cs *A, *T = cs_spalloc (n, n, nz, 1, 1) ;
if (!T) return (NULL) ;
P = cs_malloc (s, sizeof (csi)) ;
if (!P) return (cs_spfree (T)) ;
for (e = 0 ; e < nel ; e++)
{
for (i = 0 ; i < s ; i++) P [i] = rand () % n ;
for (j = 0 ; j < s ; j++)
{
for (i = 0 ; i < s ; i++)
{
cs_entry (T, P [i], P [j], rand () / (double) RAND_MAX) ;
}
}
}
for (i = 0 ; i < n ; i++) cs_entry (T, i, i, 1) ;
A = cs_compress (T) ;
cs_spfree (T) ;
return (cs_dupl (A) ? A : cs_spfree (A)) ;
}
/* load a triplet matrix from a file */
cs *cs_load (FILE *f)
{
CS_INT i, j ;
double x ;
#ifdef CS_COMPLEX
double xi ;
#endif
cs *T ;
if (!f) return (NULL) ; /* check inputs */
T = cs_spalloc (0, 0, 1, 1, 1) ; /* allocate result */
#ifdef CS_COMPLEX
while (fscanf (f, ""CS_ID" "CS_ID" %lg %lg\n", &i, &j, &x, &xi) == 4)
#else
while (fscanf (f, ""CS_ID" "CS_ID" %lg\n", &i, &j, &x) == 3)
#endif
{
#ifdef CS_COMPLEX
if (!cs_entry (T, i, j, x + xi*I)) return (cs_spfree (T)) ;
#else
if (!cs_entry (T, i, j, x)) return (cs_spfree (T)) ;
#endif
}
return (T) ;
}
void* eigs_dsdrv2_init_cs( int n, const void *data_A, const void *data_M,
const EigsOpts_t *opts, cs_fact_type_t type )
{
const cs *A = (const cs*) data_A;
(void) data_M;
cs *C, *B, *T;
int i, f;
cs_fact_t *fact;
if (opts->sigma == 0.) {
C = (cs*) A;
f = 0;
}
else {
/* Create Temoporary B matrix as the identity. */
B = cs_spalloc( n, n, n, 1, 1 );
for (i=0; i<n; i++)
cs_entry( B, i, i, 1 );
T = B;
B = cs_compress( T );
cs_spfree( T );
/* C = A - sigma B */
C = cs_add( A, B, 1.0, -opts->sigma );
cs_spfree( B );
f = 1;
}
/* Factorize C and keep factorization. */
fact = cs_fact_init_type( C, type );
if (f)
cs_spfree(C);
return fact;
}