SEXP Csparse_general_to_symmetric(SEXP x, SEXP uplo)
{
CHM_SP chx = AS_CHM_SP__(x), chgx;
int uploT = (*CHAR(STRING_ELT(uplo,0)) == 'U') ? 1 : -1;
int Rkind = (chx->xtype != CHOLMOD_PATTERN) ? Real_kind(x) : 0;
R_CheckStack();
chgx = cholmod_l_copy(chx, /* stype: */ uploT, chx->xtype, &c);
/* xtype: pattern, "real", complex or .. */
return chm_sparse_to_SEXP(chgx, 1, 0, Rkind, "",
GET_SLOT(x, Matrix_DimNamesSym));
}
// FIXME: do not go via CHM (should not be too hard, to just *drop* the x-slot, right?
SEXP Csparse_to_nz_pattern(SEXP x, SEXP tri)
{
CHM_SP chxs = AS_CHM_SP__(x);
CHM_SP chxcp = cholmod_l_copy(chxs, chxs->stype, CHOLMOD_PATTERN, &c);
int tr = asLogical(tri);
R_CheckStack();
return chm_sparse_to_SEXP(chxcp, 1/*do_free*/,
tr ? ((*uplo_P(x) == 'U') ? 1 : -1) : 0,
0, tr ? diag_P(x) : "",
GET_SLOT(x, Matrix_DimNamesSym));
}
/* this used to be called sCMatrix_to_gCMatrix(..) [in ./dsCMatrix.c ]: */
SEXP Csparse_symmetric_to_general(SEXP x)
{
CHM_SP chx = AS_CHM_SP__(x), chgx;
int Rkind = (chx->xtype != CHOLMOD_PATTERN) ? Real_kind(x) : 0;
R_CheckStack();
if (!(chx->stype))
error(_("Nonsymmetric matrix in Csparse_symmetric_to_general"));
chgx = cholmod_l_copy(chx, /* stype: */ 0, chx->xtype, &c);
/* xtype: pattern, "real", complex or .. */
return chm_sparse_to_SEXP(chgx, 1, 0, Rkind, "",
GET_SLOT(x, Matrix_DimNamesSym));
}
/* FIXME: Create a more general version of this operation: also for lsC, (dsR?),..
* e.g. make compressed_to_dgTMatrix() in ./dgCMatrix.c work for dsC */
SEXP dsCMatrix_to_dgTMatrix(SEXP x)
{
CHM_SP A = AS_CHM_SP__(x);
CHM_SP Afull = cholmod_l_copy(A, /*stype*/ 0, /*mode*/ 1, &c);
CHM_TR At = cholmod_l_sparse_to_triplet(Afull, &c);
R_CheckStack();
if (!A->stype)
error("Non-symmetric matrix passed to dsCMatrix_to_dgTMatrix");
cholmod_l_free_sparse(&Afull, &c);
return chm_triplet_to_SEXP(At, 1, /*uploT*/ 0, /*Rkind*/ 0, "",
GET_SLOT(x, Matrix_DimNamesSym));
}
/* Csparse_drop(x, tol): drop entries with absolute value < tol, i.e,
* at least all "explicit" zeros */
SEXP Csparse_drop(SEXP x, SEXP tol)
{
const char *cl = class_P(x);
/* dtCMatrix, etc; [1] = the second character =?= 't' for triangular */
int tr = (cl[1] == 't');
CHM_SP chx = AS_CHM_SP__(x);
CHM_SP ans = cholmod_l_copy(chx, chx->stype, chx->xtype, &c);
double dtol = asReal(tol);
int Rkind = (chx->xtype != CHOLMOD_PATTERN) ? Real_kind(x) : 0;
R_CheckStack();
if(!cholmod_l_drop(dtol, ans, &c))
error(_("cholmod_l_drop() failed"));
return chm_sparse_to_SEXP(ans, 1,
tr ? ((*uplo_P(x) == 'U') ? 1 : -1) : 0,
Rkind, tr ? diag_P(x) : "",
GET_SLOT(x, Matrix_DimNamesSym));
}
/**
* "Indexing" aka subsetting : Compute x[i,j], also for vectors i and j
* Working via CHOLMOD_submatrix, see ./CHOLMOD/MatrixOps/cholmod_submatrix.c
* @param x CsparseMatrix
* @param i row indices (0-origin), or NULL (R's)
* @param j columns indices (0-origin), or NULL
*
* @return x[i,j] still CsparseMatrix --- currently, this loses dimnames
*/
SEXP Csparse_submatrix(SEXP x, SEXP i, SEXP j)
{
CHM_SP chx = AS_CHM_SP(x); /* << does diagU2N() when needed */
int rsize = (isNull(i)) ? -1 : LENGTH(i),
csize = (isNull(j)) ? -1 : LENGTH(j);
int Rkind = (chx->xtype != CHOLMOD_PATTERN) ? Real_kind(x) : 0;
R_CheckStack();
if (rsize >= 0 && !isInteger(i))
error(_("Index i must be NULL or integer"));
if (csize >= 0 && !isInteger(j))
error(_("Index j must be NULL or integer"));
if (chx->stype) /* symmetricMatrix */
/* for now, cholmod_submatrix() only accepts "generalMatrix" */
chx = cholmod_l_copy(chx, /* stype: */ 0, chx->xtype, &c);
return chm_sparse_to_SEXP(cholmod_l_submatrix(chx,
(rsize < 0) ? NULL : INTEGER(i), rsize,
(csize < 0) ? NULL : INTEGER(j), csize,
TRUE, TRUE, &c),
1, 0, Rkind, "",
/* FIXME: drops dimnames */ R_NilValue);
}
