SEXP csc_tcrossprod(SEXP x)
{
cholmod_sparse *cha = cholmod_aat(as_cholmod_sparse(x),
(int *) NULL, 0, 1, &c);
cha->stype = -1; /* set the symmetry */
cholmod_sort(cha, &c); /* drop redundant entries */
return chm_sparse_to_SEXP(cha, -1);
}
cholmod_sparse *MultivariateFNormalSufficientSparse::compute_PTP() const
{
IMP_LOG(TERSE, "MVNsparse: computing PTP" << std::endl);
cholmod_sparse *eps = cholmod_dense_to_sparse(epsilon_, true, c_);
cholmod_sparse *tmp = cholmod_spsolve(CHOLMOD_A, L_, eps, c_);
cholmod_sparse *ptp = cholmod_aat(tmp, nullptr, 0, 1, c_);
cholmod_free_sparse(&eps, c_);
cholmod_free_sparse(&tmp, c_);
return ptp;
}
cholmod_sparse* get_second_power(cholmod_sparse* const NNE,
const bool directed,
cholmod_common* const cholmod_c) {
cholmod_sparse* out;
if (directed) {
// out = (NNE | t(NNE) | t(NNE) %*% NNE) & !I
cholmod_sparse* NNEt = cholmod_transpose(NNE, CHOLMOD_PATTERN, cholmod_c);
cholmod_sparse* NNEtNNE = cholmod_aat(NNEt, NULL, 0, -1, cholmod_c); // -1 = no diagnol
cholmod_sparse* tmp = cholmod_add(NNE, NNEt, NULL, NULL, false, false, cholmod_c);
cholmod_free_sparse(&NNEt, cholmod_c);
out = cholmod_add(tmp, NNEtNNE, NULL, NULL, false, false, cholmod_c);
cholmod_free_sparse(&NNEtNNE, cholmod_c);
cholmod_free_sparse(&tmp, cholmod_c);
} else {
// out = (NNE | t(NNE) %*% NNE) & !I
cholmod_sparse* NNEtNNE = cholmod_aat(NNE, NULL, 0, -1, cholmod_c); // -1 = no diagnol
out = cholmod_add(NNE, NNEtNNE, NULL, NULL, false, false, cholmod_c);
cholmod_free_sparse(&NNEtNNE, cholmod_c);
}
return out;
}
/* Computes x'x or x x' -- *also* for Tsparse (triplet = TRUE)
see Csparse_Csparse_crossprod above for x'y and x y' */
SEXP Csparse_crossprod(SEXP x, SEXP trans, SEXP triplet)
{
int trip = asLogical(triplet),
tr = asLogical(trans); /* gets reversed because _aat is tcrossprod */
#ifdef AS_CHM_DIAGU2N_FIXED_FINALLY
CHM_TR cht = trip ? AS_CHM_TR(x) : (CHM_TR) NULL;
#else /* workaround needed:*/
SEXP xx = PROTECT(Tsparse_diagU2N(x));
CHM_TR cht = trip ? AS_CHM_TR__(xx) : (CHM_TR) NULL;
#endif
CHM_SP chcp, chxt,
chx = (trip ?
cholmod_triplet_to_sparse(cht, cht->nnz, &c) :
AS_CHM_SP(x));
SEXP dn = PROTECT(allocVector(VECSXP, 2));
R_CheckStack();
if (!tr) chxt = cholmod_transpose(chx, chx->xtype, &c);
chcp = cholmod_aat((!tr) ? chxt : chx, (int *) NULL, 0, chx->xtype, &c);
if(!chcp) {
UNPROTECT(1);
error(_("Csparse_crossprod(): error return from cholmod_aat()"));
}
cholmod_band_inplace(0, chcp->ncol, chcp->xtype, chcp, &c);
chcp->stype = 1;
if (trip) cholmod_free_sparse(&chx, &c);
if (!tr) cholmod_free_sparse(&chxt, &c);
SET_VECTOR_ELT(dn, 0, /* establish dimnames */
duplicate(VECTOR_ELT(GET_SLOT(x, Matrix_DimNamesSym),
(tr) ? 0 : 1)));
SET_VECTOR_ELT(dn, 1, duplicate(VECTOR_ELT(dn, 0)));
#ifdef AS_CHM_DIAGU2N_FIXED_FINALLY
UNPROTECT(1);
#else
UNPROTECT(2);
#endif
return chm_sparse_to_SEXP(chcp, 1, 0, 0, "", dn);
}
static cholmod_sparse* aat(cholmod_sparse* A, int* fset, size_t fsize, int mode, cholmod_common* c) {
return cholmod_aat(A, fset, fsize, mode, c);
}
