/**
* "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) {/* non-symmetric Matrix */
return chm_sparse_to_SEXP(cholmod_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);
}
/* for now, cholmod_submatrix() only accepts "generalMatrix" */
CHM_SP tmp = cholmod_copy(chx, /* stype: */ 0, chx->xtype, &c);
CHM_SP ans = cholmod_submatrix(tmp,
(rsize < 0) ? NULL : INTEGER(i), rsize,
(csize < 0) ? NULL : INTEGER(j), csize,
TRUE, TRUE, &c);
cholmod_free_sparse(&tmp, &c);
return chm_sparse_to_SEXP(ans, 1, 0, Rkind, "", R_NilValue);
}
void MultivariateFNormalSufficientSparse::set_W(const SparseMatrix<double>& W)
{
if (W_) cholmod_free_sparse(&W_, c_);
cholmod_sparse Wtmp = Eigen::viewAsCholmod(
W.selfadjointView<Eigen::Upper>());
//W_ = cholmod_copy_sparse(&Wtmp, c_);
W_ = cholmod_copy(&Wtmp, 0, 1, c_); //unsym for spsolve
}
/* FIXME: Create a more general version of this operation */
SEXP dsCMatrix_to_dgTMatrix(SEXP x)
{
cholmod_sparse *A = as_cholmod_sparse(x);
cholmod_sparse *Afull = cholmod_copy(A, /*stype*/ 0, /*mode*/ 1, &c);
cholmod_triplet *At = cholmod_sparse_to_triplet(Afull, &c);
if (!A->stype)
error("Non-symmetric matrix passed to dsCMatrix_to_dgTMatrix");
Free(A); cholmod_free_sparse(&Afull, &c);
return chm_triplet_to_SEXP(At, 1, /*uploT*/ 0, "",
GET_SLOT(x, Matrix_DimNamesSym));
}
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_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_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_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));
}
/* 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_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_drop(dtol, ans, &c))
error(_("cholmod_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));
}
void MultivariateFNormalSufficientSparse::compute_sufficient_statistics(
double cutoff)
{
IMP_LOG(TERSE, "MVNsparse: computing sufficient statistics" << std::endl);
Fbar_ = FX_.colwise().mean();
compute_epsilon();
//
MatrixXd A(N_,M_);
MatrixXd W(M_,M_);
A = FX_.rowwise() - Fbar_.transpose();
W = A.transpose()*A;
SparseMatrix<double> Wsp(M_,M_);
for (int j=0; j<M_; ++j)
{
Wsp.startVec(j);
for (int i=0; i <= j; ++i)
{
if (std::abs(W(i,j)) > cutoff)
{
Wsp.insertBack(i,j) = W(i,j);
}
}
}
Wsp.finalize();
cholmod_sparse Wtmp = Eigen::viewAsCholmod(
Wsp.selfadjointView<Eigen::Upper>());
if (Wtmp.x == nullptr)
{
W_ = cholmod_spzeros(M_,M_,0,CHOLMOD_REAL, c_);
} else {
//W_ = cholmod_copy_sparse(&Wtmp, c_);
W_ = cholmod_copy(&Wtmp, 0, 1, c_); // don't store symmetic form
}
//std::cout << " A " << A << std::endl << std::endl;
//std::cout << " W " << W << std::endl << std::endl;
//std::cout << " W_ " << W_ << std::endl << std::endl;
IMP_LOG(TERSE, "MVNsparse: done sufficient statistics" << std::endl);
}
