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); }