Example #1
0
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;
}