SEXP Csparse_MatrixMarket(SEXP x, SEXP fname)
{
FILE *f = fopen(CHAR(asChar(fname)), "w");
if (!f)
error(_("failure to open file \"%s\" for writing"),
CHAR(asChar(fname)));
if (!cholmod_l_write_sparse(f, AS_CHM_SP(x),
(CHM_SP)NULL, (char*) NULL, &c))
error(_("cholmod_l_write_sparse returned error code"));
fclose(f);
return R_NilValue;
}
int main (int argc, char **argv)
{
cholmod_sparse *A, *R ;
cholmod_dense *B, *C ;
SuiteSparse_long *E ;
int mtype ;
long m, n, rnk ;
size_t total_mem, available_mem ;
double t ;
// start CHOLMOD
cholmod_common *cc, Common ;
cc = &Common ;
cholmod_l_start (cc) ;
// warmup the GPU. This can take some time, but only needs
// to be done once
cc->useGPU = false ;
t = SuiteSparse_time ( ) ;
cholmod_l_gpu_memorysize (&total_mem, &available_mem, cc) ;
cc->gpuMemorySize = available_mem ;
t = SuiteSparse_time ( ) - t ;
if (cc->gpuMemorySize <= 1)
{
printf ("no GPU available\n") ;
}
printf ("available GPU memory: %g MB, warmup time: %g\n",
(double) (cc->gpuMemorySize) / (1024 * 1024), t) ;
// A = mread (stdin) ; read in the sparse matrix A
const char *filename = argv[1];
FILE *file = fopen(filename, "r");
A = (cholmod_sparse *) cholmod_l_read_matrix (file, 1, &mtype, cc) ;
fclose(file);
if (mtype != CHOLMOD_SPARSE)
{
printf ("input matrix must be sparse\n") ;
exit (1) ;
}
// [m n] = size (A) ;
m = A->nrow ;
n = A->ncol ;
long ordering = (argc < 3 ? SPQR_ORDERING_DEFAULT : atoi(argv[2]));
printf ("Matrix %6ld-by-%-6ld nnz: %6ld\n",
m, n, cholmod_l_nnz (A, cc)) ;
// B = ones (m,1), a dense right-hand-side of the same type as A
B = cholmod_l_ones (m, 1, A->xtype, cc) ;
double tol = SPQR_NO_TOL ;
long econ = 0 ;
// [Q,R,E] = qr (A), but discard Q
// SuiteSparseQR <double> (ordering, tol, econ, A, &R, &E, cc) ;
// [C,R,E] = qr (A,b), but discard Q
SuiteSparseQR <double> (ordering, tol, econ, A, B, &C, &R, &E, cc) ;
// now R'*R-A(:,E)'*A(:,E) should be epsilon
// and C = Q'*b. The solution to the least-squares problem
// should be x=R\C.
// write out R to a file
FILE *f = fopen ("R.mtx", "w") ;
cholmod_l_write_sparse (f, R, NULL, NULL, cc) ;
fclose (f) ;
// write out C to a file
f = fopen ("C.mtx", "w") ;
cholmod_l_write_dense (f, C, NULL, cc) ;
fclose (f) ;
// write out E to a file
f = fopen ("E.txt", "w") ;
for (long i = 0 ; i < n ; i++)
{
fprintf (f, "%ld\n", 1 + E [i]) ;
}
fclose (f) ;
// free everything
cholmod_l_free_sparse (&A, cc) ;
cholmod_l_free_sparse (&R, cc) ;
cholmod_l_free_dense (&C, cc) ;
// cholmod_l_free (&E, cc) ;
cholmod_l_finish (cc) ;
return (0) ;
}
void mexFunction
(
int nargout,
mxArray *pargout [ ],
int nargin,
const mxArray *pargin [ ]
)
{
double dummy = 0 ;
cholmod_sparse Amatrix, Zmatrix, *A, *Z ;
cholmod_dense Xmatrix, *X ;
cholmod_common Common, *cm ;
Int arg_z, arg_comments, sym ;
char filename [MAXLEN], comments [MAXLEN] ;
/* ---------------------------------------------------------------------- */
/* start CHOLMOD and set parameters */
/* ---------------------------------------------------------------------- */
cm = &Common ;
cholmod_l_start (cm) ;
sputil_config (SPUMONI, cm) ;
/* ---------------------------------------------------------------------- */
/* check inputs */
/* ---------------------------------------------------------------------- */
if (nargin < 2 || nargin > 4 || nargout > 1)
{
mexErrMsgTxt ("Usage: mwrite (filename, A, Z, comments_filename)") ;
}
/* ---------------------------------------------------------------------- */
/* get the output filename */
/* ---------------------------------------------------------------------- */
if (!mxIsChar (pargin [0]))
{
mexErrMsgTxt ("first parameter must be a filename") ;
}
mxGetString (pargin [0], filename, MAXLEN) ;
/* ---------------------------------------------------------------------- */
/* get the A matrix (sparse or dense) */
/* ---------------------------------------------------------------------- */
if (mxIsSparse (pargin [1]))
{
A = sputil_get_sparse (pargin [1], &Amatrix, &dummy, 0) ;
X = NULL ;
}
else
{
X = sputil_get_dense (pargin [1], &Xmatrix, &dummy) ;
A = NULL ;
}
/* ---------------------------------------------------------------------- */
/* determine if the Z matrix and comments_file are present */
/* ---------------------------------------------------------------------- */
if (nargin == 3)
{
if (mxIsChar (pargin [2]))
{
/* mwrite (file, A, comments) */
arg_z = -1 ;
arg_comments = 2 ;
}
else
{
/* mwrite (file, A, Z). Ignore Z if A is full */
arg_z = (A == NULL) ? -1 : 2 ;
arg_comments = -1 ;
}
}
else if (nargin == 4)
{
/* mwrite (file, A, Z, comments). Ignore Z is A is full */
arg_z = (A == NULL) ? -1 : 2 ;
arg_comments = 3 ;
}
else
{
arg_z = -1 ;
arg_comments = -1 ;
}
/* ---------------------------------------------------------------------- */
/* get the Z matrix */
/* ---------------------------------------------------------------------- */
if (arg_z == -1 ||
mxGetM (pargin [arg_z]) == 0 || mxGetN (pargin [arg_z]) == 0)
{
/* A is dense, Z is not present, or Z is empty. Ignore Z. */
Z = NULL ;
}
else
{
/* A is sparse and Z is present and not empty */
if (!mxIsSparse (pargin [arg_z]))
{
mexErrMsgTxt ("Z must be sparse") ;
}
Z = sputil_get_sparse (pargin [arg_z], &Zmatrix, &dummy, 0) ;
}
/* ---------------------------------------------------------------------- */
/* get the comments filename */
/* ---------------------------------------------------------------------- */
comments [0] = '\0' ;
if (arg_comments != -1)
{
if (!mxIsChar (pargin [arg_comments]))
{
mexErrMsgTxt ("comments filename must be a string") ;
}
mxGetString (pargin [arg_comments], comments, MAXLEN) ;
}
/* ---------------------------------------------------------------------- */
/* write the matrix to the file */
/* ---------------------------------------------------------------------- */
sputil_file = fopen (filename, "w") ;
if (sputil_file == NULL)
{
mexErrMsgTxt ("error opening file") ;
}
if (A != NULL)
{
sym = cholmod_l_write_sparse (sputil_file, A, Z, comments, cm) ;
}
else
{
sym = cholmod_l_write_dense (sputil_file, X, comments, cm) ;
}
fclose (sputil_file) ;
sputil_file = NULL ;
if (sym < 0)
{
mexErrMsgTxt ("mwrite failed") ;
}
/* ---------------------------------------------------------------------- */
/* free workspace and return symmetry */
/* ---------------------------------------------------------------------- */
pargout [0] = sputil_put_int (&sym, 1, 0) ;
cholmod_l_finish (cm) ;
cholmod_l_print_common (" ", cm) ;
}
