/* 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_l_triplet_to_sparse(cht, cht->nnz, &c) :
AS_CHM_SP(x));
SEXP dn = PROTECT(allocVector(VECSXP, 2));
R_CheckStack();
if (!tr) chxt = cholmod_l_transpose(chx, chx->xtype, &c);
chcp = cholmod_l_aat((!tr) ? chxt : chx, (int *) NULL, 0, chx->xtype, &c);
if(!chcp) {
UNPROTECT(1);
error(_("Csparse_crossprod(): error return from cholmod_l_aat()"));
}
cholmod_l_band_inplace(0, chcp->ncol, chcp->xtype, chcp, &c);
chcp->stype = 1;
if (trip) cholmod_l_free_sparse(&chx, &c);
if (!tr) cholmod_l_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, SuiteSparse_long* fset, size_t fsize, int mode, cholmod_common* c) {
return cholmod_l_aat(A, fset, fsize, mode, c);
}
