/* Can only return [dln]geMatrix (no symm/triang);
* FIXME: replace by non-CHOLMOD code ! */
SEXP Csparse_to_dense(SEXP x)
{
CHM_SP chxs = AS_CHM_SP__(x);
/* This loses the symmetry property, since cholmod_dense has none,
* BUT, much worse (FIXME!), it also transforms CHOLMOD_PATTERN ("n") matrices
* to numeric (CHOLMOD_REAL) ones : */
CHM_DN chxd = cholmod_l_sparse_to_dense(chxs, &c);
int Rkind = (chxs->xtype == CHOLMOD_PATTERN)? -1 : Real_kind(x);
R_CheckStack();
return chm_dense_to_SEXP(chxd, 1, Rkind, GET_SLOT(x, Matrix_DimNamesSym));
}
SEXP Csparse_to_matrix(SEXP x)
{
return chm_dense_to_matrix(cholmod_l_sparse_to_dense(AS_CHM_SP__(x), &c),
1 /*do_free*/, GET_SLOT(x, Matrix_DimNamesSym));
}
void mexFunction
(
int nargout,
mxArray *pargout [ ],
int nargin,
const mxArray *pargin [ ]
)
{
double dummy = 0, *Px, *Xsetx ;
Long *Lp, *Lnz, *Xp, *Xi, xnz, *Perm, *Lprev, *Lnext, *Xsetp ;
cholmod_sparse *Bset, Bmatrix, *Xset ;
cholmod_dense *Bdense, *X, *Y, *E ;
cholmod_factor *L ;
cholmod_common Common, *cm ;
Long k, j, n, head, tail, xsetlen ;
int sys, kind ;
/* ---------------------------------------------------------------------- */
/* start CHOLMOD and set parameters */
/* ---------------------------------------------------------------------- */
cm = &Common ;
cholmod_l_start (cm) ;
sputil_config (SPUMONI, cm) ;
/* ---------------------------------------------------------------------- */
/* check inputs */
/* ---------------------------------------------------------------------- */
if (nargin != 5 || nargout > 2)
{
mexErrMsgTxt ("usage: [x xset] = lsubsolve (L,kind,P,b,system)") ;
}
n = mxGetN (pargin [0]) ;
if (!mxIsSparse (pargin [0]) || n != mxGetM (pargin [0]))
{
mexErrMsgTxt ("lsubsolve: L must be sparse and square") ;
}
if (mxGetNumberOfElements (pargin [1]) != 1)
{
mexErrMsgTxt ("lsubsolve: kind must be a scalar") ;
}
if (mxIsSparse (pargin [2]) ||
!(mxIsEmpty (pargin [2]) || mxGetNumberOfElements (pargin [2]) == n))
{
mexErrMsgTxt ("lsubsolve: P must be size n, or empty") ;
}
if (mxGetM (pargin [3]) != n || mxGetN (pargin [3]) != 1)
{
mexErrMsgTxt ("lsubsolve: b wrong dimension") ;
}
if (!mxIsSparse (pargin [3]))
{
mexErrMsgTxt ("lxbpattern: b must be sparse") ;
}
if (mxGetNumberOfElements (pargin [4]) != 1)
{
mexErrMsgTxt ("lsubsolve: system must be a scalar") ;
}
/* ---------------------------------------------------------------------- */
/* get the inputs */
/* ---------------------------------------------------------------------- */
kind = (int) sputil_get_integer (pargin [1], FALSE, 0) ;
sys = (int) sputil_get_integer (pargin [4], FALSE, 0) ;
/* ---------------------------------------------------------------------- */
/* get the sparse b */
/* ---------------------------------------------------------------------- */
/* get sparse matrix B (unsymmetric) */
Bset = sputil_get_sparse (pargin [3], &Bmatrix, &dummy, 0) ;
Bdense = cholmod_l_sparse_to_dense (Bset, cm) ;
Bset->x = NULL ;
Bset->z = NULL ;
Bset->xtype = CHOLMOD_PATTERN ;
/* ---------------------------------------------------------------------- */
/* construct a shallow copy of the input sparse matrix L */
/* ---------------------------------------------------------------------- */
/* the construction of the CHOLMOD takes O(n) time and memory */
/* allocate the CHOLMOD symbolic L */
L = cholmod_l_allocate_factor (n, cm) ;
L->ordering = CHOLMOD_NATURAL ;
/* get the MATLAB L */
L->p = mxGetJc (pargin [0]) ;
L->i = mxGetIr (pargin [0]) ;
L->x = mxGetPr (pargin [0]) ;
L->z = mxGetPi (pargin [0]) ;
/* allocate and initialize the rest of L */
L->nz = cholmod_l_malloc (n, sizeof (Long), cm) ;
Lp = L->p ;
Lnz = L->nz ;
for (j = 0 ; j < n ; j++)
{
Lnz [j] = Lp [j+1] - Lp [j] ;
}
/* these pointers are not accessed in cholmod_solve2 */
L->prev = cholmod_l_malloc (n+2, sizeof (Long), cm) ;
L->next = cholmod_l_malloc (n+2, sizeof (Long), cm) ;
Lprev = L->prev ;
Lnext = L->next ;
head = n+1 ;
tail = n ;
Lnext [head] = 0 ;
Lprev [head] = -1 ;
Lnext [tail] = -1 ;
Lprev [tail] = n-1 ;
for (j = 0 ; j < n ; j++)
{
Lnext [j] = j+1 ;
Lprev [j] = j-1 ;
}
Lprev [0] = head ;
L->xtype = (mxIsComplex (pargin [0])) ? CHOLMOD_ZOMPLEX : CHOLMOD_REAL ;
L->nzmax = Lp [n] ;
/* get the permutation */
if (mxIsEmpty (pargin [2]))
{
L->Perm = NULL ;
Perm = NULL ;
}
else
{
L->ordering = CHOLMOD_GIVEN ;
L->Perm = cholmod_l_malloc (n, sizeof (Long), cm) ;
Perm = L->Perm ;
Px = mxGetPr (pargin [2]) ;
for (k = 0 ; k < n ; k++)
{
Perm [k] = ((Long) Px [k]) - 1 ;
}
}
/* set the kind, LL' or LDL' */
L->is_ll = (kind == 0) ;
/*
cholmod_l_print_factor (L, "L", cm) ;
*/
/* ---------------------------------------------------------------------- */
/* solve the system */
/* ---------------------------------------------------------------------- */
X = cholmod_l_zeros (n, 1, L->xtype, cm) ;
Xset = NULL ;
Y = NULL ;
E = NULL ;
cholmod_l_solve2 (sys, L, Bdense, Bset, &X, &Xset, &Y, &E, cm) ;
cholmod_l_free_dense (&Y, cm) ;
cholmod_l_free_dense (&E, cm) ;
/* ---------------------------------------------------------------------- */
/* return result */
/* ---------------------------------------------------------------------- */
pargout [0] = sputil_put_dense (&X, cm) ;
/* fill numerical values of Xset with one's */
Xsetp = Xset->p ;
xsetlen = Xsetp [1] ;
Xset->x = cholmod_l_malloc (xsetlen, sizeof (double), cm) ;
Xsetx = Xset->x ;
for (k = 0 ; k < xsetlen ; k++)
{
Xsetx [k] = 1 ;
}
Xset->xtype = CHOLMOD_REAL ;
pargout [1] = sputil_put_sparse (&Xset, cm) ;
/* ---------------------------------------------------------------------- */
/* free workspace and the CHOLMOD L, except for what is copied to MATLAB */
/* ---------------------------------------------------------------------- */
L->p = NULL ;
L->i = NULL ;
L->x = NULL ;
L->z = NULL ;
cholmod_l_free_factor (&L, cm) ;
cholmod_l_finish (cm) ;
cholmod_l_print_common (" ", cm) ;
}
