SEXP gCMatrix_colSums(SEXP x, SEXP NArm, SEXP spRes, SEXP trans, SEXP means) { int mn = asLogical(means), sp = asLogical(spRes), tr = asLogical(trans); /* cholmod_sparse: drawback of coercing lgC to double: */ CHM_SP cx = AS_CHM_SP(x); R_CheckStack(); if (tr) { cholmod_sparse *cxt = cholmod_transpose(cx, (int)cx->xtype, &c); cx = cxt; } /* everything else *after* the above potential transpose : */ /* Don't declarations here require the C99 standard? Can we assume C99? */ int j, nc = cx->ncol; int *xp = (int *)(cx -> p); #ifdef _has_x_slot_ int na_rm = asLogical(NArm), i, dnm = 0/*Wall*/; double *xx = (double *)(cx -> x); #endif SEXP ans = PROTECT(sp ? NEW_OBJECT(MAKE_CLASS(SparseResult_class)) : allocVector(SXP_ans, nc)); if (sp) { /* sparseResult - never allocating length-nc ... */ int nza, i1, i2, p, *ai; Type_ans *ax; for (j = 0, nza = 0; j < nc; j++) if(xp[j] < xp[j + 1]) nza++; ai = INTEGER(ALLOC_SLOT(ans, Matrix_iSym, INTSXP, nza)); ax = STYP_ans(ALLOC_SLOT(ans, Matrix_xSym, SXP_ans, nza)); SET_SLOT(ans, Matrix_lengthSym, ScalarInteger(nc)); i2 = xp[0]; for (j = 1, p = 0; j <= nc; j++) { /* j' =j+1, since 'i' slot will be 1-based */ i1 = i2; i2 = xp[j]; if(i1 < i2) { Type_ans sum; ColSUM_column(i1,i2, sum); ai[p] = j; ax[p++] = sum; } } } else { /* "numeric" (non sparse) result */ Type_ans *a = STYP_ans(ans); for (j = 0; j < nc; j++) { ColSUM_column(xp[j], xp[j + 1], a[j]); } } if (tr) cholmod_free_sparse(&cx, &c); UNPROTECT(1); return ans; }
/** * colSums(), colMeans(), rowSums() and rowMeans() for all sparce *gCMatrix()es * @param x a ?gCMatrix, i.e. sparse column-compressed Matrix * @param NArm logical indicating if NA's should be remove 'na.rm' in R * @param spRes logical = 'sparseResult' indicating if result should be sparse * @param trans logical: TRUE <==> row[Sums/Means] <==> compute col*s( t(x) ) * @param means logical: TRUE <==> compute [row/col]Means() , not *Sums() */ SEXP gCMatrix_colSums(SEXP x, SEXP NArm, SEXP spRes, SEXP trans, SEXP means) { int mn = asLogical(means), sp = asLogical(spRes), tr = asLogical(trans); /* cholmod_sparse: drawback of coercing lgC to double: */ CHM_SP cx = AS_CHM_SP__(x); R_CheckStack(); if (tr) { cholmod_sparse *cxt = cholmod_transpose(cx, (int)cx->xtype, &c); cx = cxt; } /* everything else *after* the above potential transpose : */ int j, nc = cx->ncol; int *xp = (int *)(cx -> p); #ifdef _has_x_slot_ int na_rm = asLogical(NArm), // can have NAs only with an 'x' slot i, dnm = 0/*Wall*/; double *xx = (double *)(cx -> x); #endif // result value: sparseResult (==> "*sparseVector") or dense (atomic)vector SEXP ans = PROTECT(sp ? NEW_OBJECT(MAKE_CLASS(SparseResult_class)) : allocVector(SXP_ans, nc)); if (sp) { // sparseResult, i.e. *sparseVector (never allocating length-nc) int nza, i1, i2, p, *ai; Type_ans *ax; for (j = 0, nza = 0; j < nc; j++) if(xp[j] < xp[j + 1]) nza++; ai = INTEGER(ALLOC_SLOT(ans, Matrix_iSym, INTSXP, nza)); ax = STYP_ans(ALLOC_SLOT(ans, Matrix_xSym, SXP_ans, nza)); SET_SLOT(ans, Matrix_lengthSym, ScalarInteger(nc)); i2 = xp[0]; for (j = 1, p = 0; j <= nc; j++) { /* j' =j+1, since 'i' slot will be 1-based */ i1 = i2; i2 = xp[j]; if(i1 < i2) { Type_ans sum; ColSUM_column(i1,i2, sum); ai[p] = j; ax[p++] = sum; } } } else { /* "numeric" (non sparse) result */ Type_ans *a = STYP_ans(ans); for (j = 0; j < nc; j++) { ColSUM_column(xp[j], xp[j + 1], a[j]); } } if (tr) cholmod_free_sparse(&cx, &c); if (!sp) { SEXP nms = VECTOR_ELT(GET_SLOT(x, Matrix_DimNamesSym), tr ? 0 : 1); if (!isNull(nms)) setAttrib(ans, R_NamesSymbol, duplicate(nms)); } UNPROTECT(1); return ans; }