/* free a problem */
problem *free_problem (problem *Prob)
{
if (!Prob) return (NULL) ;
cs_cl_spfree (Prob->A) ;
if (Prob->sym) cs_cl_spfree (Prob->C) ;
cs_cl_free (Prob->b) ;
cs_cl_free (Prob->x) ;
cs_cl_free (Prob->resid) ;
return (cs_cl_free (Prob)) ;
}
/* free workspace for demo3 */
static cs_long_t done3 (cs_long_t ok, cs_cls *S, cs_cln *N, cs_complex_t *y, cs_cl *W, cs_cl *E, cs_long_t *p)
{
cs_cl_sfree (S) ;
cs_cl_nfree (N) ;
cs_cl_free (y) ;
cs_cl_spfree (W) ;
cs_cl_spfree (E) ;
cs_cl_free (p) ;
return (ok) ;
}
void mexFunction
(
int nargout,
mxArray *pargout [ ],
int nargin,
const mxArray *pargin [ ]
)
{
if (nargout > 1 || nargin < 2 || nargin > 4)
{
mexErrMsgTxt ("Usage: C = cs_add(A,B,alpha,beta)") ;
}
if (mxIsComplex (pargin [0]) || mxIsComplex (pargin [1])
|| (nargin > 2 && mxIsComplex (pargin [2]))
|| (nargin > 3 && mxIsComplex (pargin [3])))
{
#ifndef NCOMPLEX
cs_complex_t alpha, beta ;
cs_cl Amatrix, Bmatrix, *A, *B, *C, *D ;
A = cs_cl_mex_get_sparse (&Amatrix, 0, pargin [0]) ; /* get A */
B = cs_cl_mex_get_sparse (&Bmatrix, 0, pargin [1]) ; /* get B */
alpha = (nargin < 3) ? 1 : get_complex (pargin [2]) ; /* get alpha */
beta = (nargin < 4) ? 1 : get_complex (pargin [3]) ; /* get beta */
C = cs_cl_add (A,B,alpha,beta) ; /* C = alpha*A + beta *B */
cs_cl_dropzeros (C) ; /* drop zeros */
D = cs_cl_transpose (C, 1) ; /* sort result via double transpose */
cs_cl_spfree (C) ;
C = cs_cl_transpose (D, 1) ;
cs_cl_spfree (D) ;
pargout [0] = cs_cl_mex_put_sparse (&C) ; /* return C */
#else
mexErrMsgTxt ("complex matrices not supported") ;
#endif
}
else
{
double alpha, beta ;
cs_dl Amatrix, Bmatrix, *A, *B, *C, *D ;
A = cs_dl_mex_get_sparse (&Amatrix, 0, 1, pargin [0]) ; /* get A */
B = cs_dl_mex_get_sparse (&Bmatrix, 0, 1, pargin [1]) ; /* get B */
alpha = (nargin < 3) ? 1 : mxGetScalar (pargin [2]) ; /* get alpha */
beta = (nargin < 4) ? 1 : mxGetScalar (pargin [3]) ; /* get beta */
C = cs_dl_add (A,B,alpha,beta) ; /* C = alpha*A + beta *B */
cs_dl_dropzeros (C) ; /* drop zeros */
D = cs_dl_transpose (C, 1) ; /* sort result via double transpose */
cs_dl_spfree (C) ;
C = cs_dl_transpose (D, 1) ;
cs_dl_spfree (D) ;
pargout [0] = cs_dl_mex_put_sparse (&C) ; /* return C */
}
}
/* read a problem from a file; use %g for integers to avoid cs_long_t conflicts */
problem *get_problem (FILE *f, double tol)
{
cs_cl *T, *A, *C ;
cs_long_t sym, m, n, mn, nz1, nz2 ;
problem *Prob ;
Prob = cs_cl_calloc (1, sizeof (problem)) ;
if (!Prob) return (NULL) ;
T = cs_cl_load (f) ; /* load triplet matrix T from a file */
Prob->A = A = cs_cl_compress (T) ; /* A = compressed-column form of T */
cs_cl_spfree (T) ; /* clear T */
if (!cs_cl_dupl (A)) return (free_problem (Prob)) ; /* sum up duplicates */
Prob->sym = sym = is_sym (A) ; /* determine if A is symmetric */
m = A->m ; n = A->n ;
mn = CS_MAX (m,n) ;
nz1 = A->p [n] ;
cs_cl_dropzeros (A) ; /* drop zero entries */
nz2 = A->p [n] ;
if (tol > 0) cs_cl_droptol (A, tol) ; /* drop tiny entries (just to test) */
Prob->C = C = sym ? make_sym (A) : A ; /* C = A + triu(A,1)', or C=A */
if (!C) return (free_problem (Prob)) ;
printf ("\n--- Matrix: %g-by-%g, nnz: %g (sym: %g: nnz %g), norm: %8.2e\n",
(double) m, (double) n, (double) (A->p [n]), (double) sym,
(double) (sym ? C->p [n] : 0), cs_cl_norm (C)) ;
if (nz1 != nz2) printf ("zero entries dropped: %g\n", (double) (nz1 - nz2));
if (nz2 != A->p [n]) printf ("tiny entries dropped: %g\n",
(double) (nz2 - A->p [n])) ;
Prob->b = cs_cl_malloc (mn, sizeof (cs_complex_t)) ;
Prob->x = cs_cl_malloc (mn, sizeof (cs_complex_t)) ;
Prob->resid = cs_cl_malloc (mn, sizeof (cs_complex_t)) ;
return ((!Prob->b || !Prob->x || !Prob->resid) ? free_problem (Prob) : Prob) ;
}
int main (void)
{
cs_cl *T, *A, *Eye, *AT, *C, *D ;
cs_long_t i, m ;
T = cs_cl_load (stdin) ; /* load triplet matrix T from stdin */
printf ("T:\n") ; cs_cl_print (T, 0) ; /* print T */
A = cs_cl_compress (T) ; /* A = compressed-column form of T */
printf ("A:\n") ; cs_cl_print (A, 0) ; /* print A */
cs_cl_spfree (T) ; /* clear T */
AT = cs_cl_transpose (A, 1) ; /* AT = A' */
printf ("AT:\n") ; cs_cl_print (AT, 0) ; /* print AT */
m = A ? A->m : 0 ; /* m = # of rows of A */
T = cs_cl_spalloc (m, m, m, 1, 1) ; /* create triplet identity matrix */
for (i = 0 ; i < m ; i++) cs_cl_entry (T, i, i, 1) ;
Eye = cs_cl_compress (T) ; /* Eye = speye (m) */
cs_cl_spfree (T) ;
C = cs_cl_multiply (A, AT) ; /* C = A*A' */
D = cs_cl_add (C, Eye, 1, cs_cl_norm (C)) ; /* D = C + Eye*norm (C,1) */
printf ("D:\n") ; cs_cl_print (D, 0) ; /* print D */
cs_cl_spfree (A) ; /* clear A AT C D Eye */
cs_cl_spfree (AT) ;
cs_cl_spfree (C) ;
cs_cl_spfree (D) ;
cs_cl_spfree (Eye) ;
return (0) ;
}
/* C = A + triu(A,1)' */
static cs_cl *make_sym (cs_cl *A)
{
cs_cl *AT, *C ;
AT = cs_cl_transpose (A, 1) ; /* AT = A' */
cs_cl_fkeep (AT, &dropdiag, NULL) ; /* drop diagonal entries from AT */
C = cs_cl_add (A, AT, 1, 1) ; /* C = A+AT */
cs_cl_spfree (AT) ;
return (C) ;
}
/* cs_sparse: convert triplet form into compress-column form sparse matrix */
void mexFunction
(
int nargout,
mxArray *pargout [ ],
int nargin,
const mxArray *pargin [ ]
)
{
if (nargout > 1 || nargin != 3)
{
mexErrMsgTxt ("Usage: A = cs_sparse(i,j,x)") ;
}
if (mxIsComplex (pargin [2]))
{
#ifndef NCOMPLEX
cs_cl *A, *C, *T, Tmatrix ;
T = &Tmatrix ; /* get i,j,x and copy to triplet form */
T->nz = mxGetM (pargin [0]) ;
T->p = cs_dl_mex_get_int (T->nz, pargin [0], &(T->n), 1) ;
T->i = cs_dl_mex_get_int (T->nz, pargin [1], &(T->m), 1) ;
cs_mex_check (1, T->nz, 1, 0, 0, 1, pargin [2]) ;
T->x = cs_cl_mex_get_double (T->nz, pargin [2]) ;
T->nzmax = T->nz ;
C = cs_cl_compress (T) ; /* create sparse matrix C */
cs_cl_dupl (C) ; /* remove duplicates from C */
cs_cl_dropzeros (C) ; /* remove zeros from C */
A = cs_cl_transpose (C, -1) ; /* A=C.' */
cs_cl_spfree (C) ;
pargout [0] = cs_cl_mex_put_sparse (&A) ; /* return A */
cs_free (T->p) ;
cs_free (T->i) ;
cs_free (T->x) ; /* free copy of complex values*/
#else
mexErrMsgTxt ("complex matrices not supported") ;
#endif
}
else
{
cs_dl *A, *C, *T, Tmatrix ;
T = &Tmatrix ; /* get i,j,x and copy to triplet form */
T->nz = mxGetM (pargin [0]) ;
T->p = cs_dl_mex_get_int (T->nz, pargin [0], &(T->n), 1) ;
T->i = cs_dl_mex_get_int (T->nz, pargin [1], &(T->m), 1) ;
cs_mex_check (1, T->nz, 1, 0, 0, 1, pargin [2]) ;
T->x = mxGetPr (pargin [2]) ;
T->nzmax = T->nz ;
C = cs_dl_compress (T) ; /* create sparse matrix C */
cs_dl_dupl (C) ; /* remove duplicates from C */
cs_dl_dropzeros (C) ; /* remove zeros from C */
A = cs_dl_transpose (C, 1) ; /* A=C' */
cs_dl_spfree (C) ;
pargout [0] = cs_dl_mex_put_sparse (&A) ; /* return A */
cs_free (T->p) ;
cs_free (T->i) ;
}
}
/* Cholesky update/downdate */
cs_long_t demo3 (problem *Prob)
{
cs_cl *A, *C, *W = NULL, *WW, *WT, *E = NULL, *W2 ;
cs_long_t n, k, *Li, *Lp, *Wi, *Wp, p1, p2, *p = NULL, ok ;
cs_complex_t *b, *x, *resid, *y = NULL, *Lx, *Wx, s ;
double t, t1 ;
cs_cls *S = NULL ;
cs_cln *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_cl_malloc (n, sizeof (cs_complex_t)) ;
t = tic () ;
S = cs_cl_schol (1, C) ; /* symbolic Chol, amd(A+A') */
printf ("\nsymbolic chol time %8.2f\n", toc (t)) ;
t = tic () ;
N = cs_cl_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_cl_ipvec (S->pinv, b, y, n) ; /* y = P*b */
cs_cl_lsolve (N->L, y) ; /* y = L\y */
cs_cl_ltsolve (N->L, y) ; /* y = L'\y */
cs_cl_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_cl_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_cl_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_cl_ipvec (S->pinv, b, y, n) ; /* y = P*b */
cs_cl_lsolve (N->L, y) ; /* y = L\y */
cs_cl_ltsolve (N->L, y) ; /* y = L'\y */
cs_cl_pvec (S->pinv, y, x, n) ; /* x = P'*y */
t = toc (t) ;
p = cs_cl_pinv (S->pinv, n) ;
W2 = cs_cl_permute (W, p, NULL, 1) ; /* E = C + (P'W)*(P'W)' */
WT = cs_cl_transpose (W2,1) ;
WW = cs_cl_multiply (W2, WT) ;
cs_cl_spfree (WT) ;
cs_cl_spfree (W2) ;
E = cs_cl_add (C, WW, 1, 1) ;
cs_cl_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_cl_nfree (N) ; /* clear N */
t = tic () ;
N = cs_cl_chol (E, S) ; /* numeric Cholesky */
if (!N) return (done3 (0, S, N, y, W, E, p)) ;
cs_cl_ipvec (S->pinv, b, y, n) ; /* y = P*b */
cs_cl_lsolve (N->L, y) ; /* y = L\y */
cs_cl_ltsolve (N->L, y) ; /* y = L'\y */
cs_cl_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_cl_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_cl_ipvec (S->pinv, b, y, n) ; /* y = P*b */
cs_cl_lsolve (N->L, y) ; /* y = L\y */
cs_cl_ltsolve (N->L, y) ; /* y = L'\y */
cs_cl_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)) ;
}
/* cs_lu: sparse LU factorization, with optional fill-reducing ordering */
void mexFunction
(
int nargout,
mxArray *pargout [ ],
int nargin,
const mxArray *pargin [ ]
)
{
CS_INT n, order, *p ;
double tol ;
if (nargout > 4 || nargin > 3 || nargin < 1)
{
mexErrMsgTxt ("Usage: [L,U,p,q] = cs_lu (A,tol)") ;
}
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 */
}
if (mxIsComplex (pargin [0]))
{
#ifndef NCOMPLEX
cs_cls *S ;
cs_cln *N ;
cs_cl Amatrix, *A, *D ;
A = cs_cl_mex_get_sparse (&Amatrix, 1, pargin [0]) ; /* get A */
n = A->n ;
S = cs_cl_sqr (order, A, 0) ; /* symbolic ordering, no QR bound */
N = cs_cl_lu (A, S, tol) ; /* numeric factorization */
if (!N) mexErrMsgTxt ("cs_lu failed (singular, or out of memory)") ;
cs_cl_free (A->x) ; /* complex copy no longer needed */
cs_cl_dropzeros (N->L) ; /* drop zeros from L and sort it */
D = cs_cl_transpose (N->L, 1) ;
cs_cl_spfree (N->L) ;
N->L = cs_cl_transpose (D, 1) ;
cs_cl_spfree (D) ;
cs_cl_dropzeros (N->U) ; /* drop zeros from U and sort it */
D = cs_cl_transpose (N->U, 1) ;
cs_cl_spfree (N->U) ;
N->U = cs_cl_transpose (D, 1) ;
cs_cl_spfree (D) ;
p = cs_cl_pinv (N->pinv, n) ; /* p=pinv' */
pargout [0] = cs_cl_mex_put_sparse (&(N->L)) ; /* return L */
pargout [1] = cs_cl_mex_put_sparse (&(N->U)) ; /* return U */
pargout [2] = cs_dl_mex_put_int (p, n, 1, 1) ; /* return p */
/* return Q */
if (nargout == 4) pargout [3] = cs_dl_mex_put_int (S->q, n, 1, 0) ;
cs_cl_nfree (N) ;
cs_cl_sfree (S) ;
#else
mexErrMsgTxt ("complex matrices not supported") ;
#endif
}
else
{
cs_dls *S ;
cs_dln *N ;
cs_dl Amatrix, *A, *D ;
A = cs_dl_mex_get_sparse (&Amatrix, 1, 1, pargin [0]) ; /* get A */
n = A->n ;
S = cs_dl_sqr (order, A, 0) ; /* symbolic ordering, no QR bound */
N = cs_dl_lu (A, S, tol) ; /* numeric factorization */
if (!N) mexErrMsgTxt ("cs_lu failed (singular, or out of memory)") ;
cs_dl_dropzeros (N->L) ; /* drop zeros from L and sort it */
D = cs_dl_transpose (N->L, 1) ;
cs_dl_spfree (N->L) ;
N->L = cs_dl_transpose (D, 1) ;
cs_dl_spfree (D) ;
cs_dl_dropzeros (N->U) ; /* drop zeros from U and sort it */
D = cs_dl_transpose (N->U, 1) ;
cs_dl_spfree (N->U) ;
N->U = cs_dl_transpose (D, 1) ;
cs_dl_spfree (D) ;
p = cs_dl_pinv (N->pinv, n) ; /* p=pinv' */
pargout [0] = cs_dl_mex_put_sparse (&(N->L)) ; /* return L */
pargout [1] = cs_dl_mex_put_sparse (&(N->U)) ; /* return U */
pargout [2] = cs_dl_mex_put_int (p, n, 1, 1) ; /* return p */
/* return Q */
if (nargout == 4) pargout [3] = cs_dl_mex_put_int (S->q, n, 1, 0) ;
cs_dl_nfree (N) ;
cs_dl_sfree (S) ;
}
}
/* cs_qr: sparse QR factorization */
void mexFunction
(
int nargout,
mxArray *pargout [ ],
int nargin,
const mxArray *pargin [ ]
)
{
CS_INT m, n, order, *p ;
if (nargout > 5 || nargin != 1)
{
mexErrMsgTxt ("Usage: [V,beta,p,R,q] = cs_qr(A)") ;
}
order = (nargout == 5) ? 3 : 0 ; /* determine ordering */
m = mxGetM (pargin [0]) ;
n = mxGetN (pargin [0]) ;
if (m < n) mexErrMsgTxt ("A must have # rows >= # columns") ;
if (mxIsComplex (pargin [0]))
{
#ifndef NCOMPLEX
cs_cls *S ;
cs_cln *N ;
cs_cl Amatrix, *A, *D ;
A = cs_cl_mex_get_sparse (&Amatrix, 0, pargin [0]) ; /* get A */
S = cs_cl_sqr (order, A, 1) ; /* symbolic QR ordering & analysis*/
N = cs_cl_qr (A, S) ; /* numeric QR factorization */
cs_free (A->x) ;
if (!N) mexErrMsgTxt ("qr failed") ;
cs_cl_dropzeros (N->L) ; /* drop zeros from V and sort */
D = cs_cl_transpose (N->L, 1) ;
cs_cl_spfree (N->L) ;
N->L = cs_cl_transpose (D, 1) ;
cs_cl_spfree (D) ;
cs_cl_dropzeros (N->U) ; /* drop zeros from R and sort */
D = cs_cl_transpose (N->U, 1) ;
cs_cl_spfree (N->U) ;
N->U = cs_cl_transpose (D, 1) ;
cs_cl_spfree (D) ;
m = N->L->m ; /* m may be larger now */
p = cs_cl_pinv (S->pinv, m) ; /* p = pinv' */
pargout [0] = cs_cl_mex_put_sparse (&(N->L)) ; /* return V */
cs_dl_mex_put_double (n, N->B, &(pargout [1])) ; /* return beta */
pargout [2] = cs_dl_mex_put_int (p, m, 1, 1) ; /* return p */
pargout [3] = cs_cl_mex_put_sparse (&(N->U)) ; /* return R */
pargout [4] = cs_dl_mex_put_int (S->q, n, 1, 0) ; /* return q */
cs_cl_nfree (N) ;
cs_cl_sfree (S) ;
#else
mexErrMsgTxt ("complex matrices not supported") ;
#endif
}
else
{
cs_dls *S ;
cs_dln *N ;
cs_dl Amatrix, *A, *D ;
A = cs_dl_mex_get_sparse (&Amatrix, 0, 1, pargin [0]) ; /* get A */
S = cs_dl_sqr (order, A, 1) ; /* symbolic QR ordering & analysis*/
N = cs_dl_qr (A, S) ; /* numeric QR factorization */
if (!N) mexErrMsgTxt ("qr failed") ;
cs_dl_dropzeros (N->L) ; /* drop zeros from V and sort */
D = cs_dl_transpose (N->L, 1) ;
cs_dl_spfree (N->L) ;
N->L = cs_dl_transpose (D, 1) ;
cs_dl_spfree (D) ;
cs_dl_dropzeros (N->U) ; /* drop zeros from R and sort */
D = cs_dl_transpose (N->U, 1) ;
cs_dl_spfree (N->U) ;
N->U = cs_dl_transpose (D, 1) ;
cs_dl_spfree (D) ;
m = N->L->m ; /* m may be larger now */
p = cs_dl_pinv (S->pinv, m) ; /* p = pinv' */
pargout [0] = cs_dl_mex_put_sparse (&(N->L)) ; /* return V */
cs_dl_mex_put_double (n, N->B, &(pargout [1])) ; /* return beta */
pargout [2] = cs_dl_mex_put_int (p, m, 1, 1) ; /* return p */
pargout [3] = cs_dl_mex_put_sparse (&(N->U)) ; /* return R */
pargout [4] = cs_dl_mex_put_int (S->q, n, 1, 0) ; /* return q */
cs_dl_nfree (N) ;
cs_dl_sfree (S) ;
}
}