10(c == 'z') ? CPLXSXP : (mean || c == 'd' || c == 'i') ? REALSXP : INTSXP
12#define MAP(i) (map) ? map[i] : i
20#define nCAST(x) (x != 0)
24 int m,
int n,
char ul,
char ct,
char nu,
28 int i, j, count = -1, packed =
class[2] ==
'p';
32 c0##TYPE *px0 = c0##PTR( x); \
33 c1##TYPE *px1 = c1##PTR(ans); \
34 if (class[1] == 'g') { \
35 for (j = 0; j < n; ++j) { \
37 SUM_KERNEL(c0, c1, for (i = 0; i < m; ++i)); \
40 } else if (nu == 'N') { \
42 for (j = 0; j < n; ++j) { \
44 SUM_KERNEL(c0, c1, for (i = 0; i <= j; ++i)); \
50 for (j = 0; j < n; ++j) { \
54 SUM_KERNEL(c0, c1, for (i = j; i < n; ++i)); \
59 for (j = 0; j < n; ++j) { \
61 SUM_KERNEL(c0, c1, for (i = 0; i < j; ++i)); \
68 for (j = 0; j < n; ++j) { \
73 SUM_KERNEL(c0, c1, for (i = j + 1; i < n; ++i)); \
79#define SUM_KERNEL(c0, c1, __for__) \
84 if (c0##NOT_NA(*px0)) \
85 c1##INCREMENT_IDEN(*px1, c0##CAST(*px0)); \
93 c1##DIVIDE(*px1, count); \
97 case 'n':
if (mean)
SUM(n, d);
else SUM(n, i);
break;
98 case 'l':
if (mean)
SUM(l, d);
else SUM(l, i);
break;
99 case 'i':
SUM(i, d);
break;
100 case 'd':
SUM(d, d);
break;
101 case 'z':
SUM(z, z);
break;
113 int m,
int n,
char ul,
char ct,
char nu,
117 int i, j, *count = NULL, packed = XLENGTH(x) != (int_fast64_t) m * n,
118 sy =
class[1] ==
's', he = sy && ct ==
'C',
119 un =
class[1] ==
't' && nu !=
'N';
123 for (i = 0; i < m; ++i)
129 c0##TYPE *px0 = c0##PTR( x), tmp0; \
130 c1##TYPE *px1 = c1##PTR(ans), tmp1 = (un) ? c0##UNIT : c0##ZERO; \
131 for (i = 0; i < m; ++i) \
133 if (class[1] == 'g') { \
134 for (j = 0; j < n; ++j) \
135 SUM_KERNEL(c0, c1, for (i = 0; i < m; ++i)); \
136 } else if (class[1] == 's' || nu == 'N') { \
138 for (j = 0; j < n; ++j) { \
139 SUM_KERNEL(c0, c1, for (i = 0; i <= j; ++i)); \
144 for (j = 0; j < n; ++j) { \
147 SUM_KERNEL(c0, c1, for (i = j; i < n; ++i)); \
151 for (j = 0; j < n; ++j) { \
152 SUM_KERNEL(c0, c1, for (i = 0; i < j; ++i)); \
158 for (j = 0; j < n; ++j) { \
162 SUM_KERNEL(c0, c1, for (i = j + 1; i < n; ++i)); \
167 for (i = 0; i < m; ++i) \
168 c1##DIVIDE(px1[i], n); \
170 for (i = 0; i < m; ++i) \
171 c1##DIVIDE(px1[i], count[i]); \
175#define SUM_KERNEL(c0, c1, __for__) \
179 c0##ASSIGN_PROJ_REAL(tmp0, *px0); \
181 c0##ASSIGN_IDEN (tmp0, *px0); \
182 if (c0##NOT_NA(tmp0)) { \
183 c1##INCREMENT_IDEN(px1[i], c0##CAST(tmp0)); \
184 if (sy && i != j) { \
186 c1##INCREMENT_CONJ(px1[j], c0##CAST(tmp0)); \
188 c1##INCREMENT_IDEN(px1[j], c0##CAST(tmp0)); \
190 } else if (!narm) { \
204 case 'n':
if (mean)
SUM(n, d);
else SUM(n, i);
break;
205 case 'l':
if (mean)
SUM(l, d);
else SUM(l, i);
break;
206 case 'i':
SUM(i, d);
break;
207 case 'd':
SUM(d, d);
break;
208 case 'z':
SUM(z, z);
break;
225 int m,
int n,
char ul,
char ct,
char nu,
230 int *pp0 = INTEGER(p0), j, k, kend, nnz1, count = -1,
231 un =
class[1] ==
't' && nu !=
'N';
235 if (
TYPEOF(ans) != OBJSXP) {
243 for (j = 0; j < n; ++j)
244 if (pp0[j - 1] < pp0[j])
248 SEXP j1 = PROTECT(Rf_allocVector(INTSXP, nnz1));
249 int *pj1 = INTEGER(j1);
252 for (j = 0; j < n; ++j)
255 for (j = 0; j < n; ++j)
256 if (pp0[j - 1] < pp0[j])
259 PROTECT(x1 = Rf_allocVector(
SUM_TYPEOF(
class[0]), nnz1));
266 int full = nnz1 == n;
271 SEXP x0 = GET_SLOT(obj, Matrix_xSym); \
272 c0##TYPE *px0 = c0##PTR(x0); \
274 c1##TYPE *px1 = c1##PTR(x1), tmp1 = (un) ? c1##UNIT : c1##ZERO; \
275 for (j = 0, k = 0; j < n; ++j) { \
277 if (full || k < kend) { \
282 if (c0##NOT_NA(*px0)) \
283 c1##INCREMENT_IDEN(*px1, c0##CAST(*px0)); \
294 c1##DIVIDE(*px1, count); \
301 case 'n':
if (mean)
SUM(n, d);
else SUM(n, i);
break;
302 case 'l':
if (mean)
SUM(l, d);
else SUM(l, i);
break;
303 case 'i':
SUM(i, d);
break;
304 case 'd':
SUM(d, d);
break;
305 case 'z':
SUM(z, z);
break;
317 int m,
int n,
char ul,
char ct,
char nu,
323 int *pp0 = INTEGER(p0), *pi0 = INTEGER(i0), i, j, k, kend, nnz1,
324 *count = NULL, *map = NULL,
325 sy =
class[1] ==
's', he = sy && ct ==
'C',
326 un =
class[1] ==
't' && nu !=
'N';
330 if (
TYPEOF(ans) != OBJSXP) {
335 for (i = 0; i < m; ++i)
344 for (j = 0, k = 0; j < n; ++j) {
354 for (i = 0; i < m; ++i)
355 map[i] = (map[i]) ? nnz1++ : -1;
358 SEXP i1 = PROTECT(Rf_allocVector(INTSXP, nnz1));
362 for (i = 0; i < nnz1; ++i)
366 PROTECT(x1 = Rf_allocVector(
SUM_TYPEOF(
class[0]), nnz1));
376 SEXP x0 = GET_SLOT(obj, Matrix_xSym); \
377 c0##TYPE *px0 = c0##PTR(x0); \
380 c1##TYPE *px1 = c1##PTR(x1), tmp1 = (un) ? c1##UNIT : c1##ZERO; \
381 for (i = 0; i < nnz1; ++i) \
383 for (j = 0, k = 0; j < n; ++j) { \
388 c0##ASSIGN_PROJ_REAL(tmp0, c0##IFELSE_NPATTERN(px0[k], c0##UNIT)); \
390 c0##ASSIGN_IDEN (tmp0, c0##IFELSE_NPATTERN(px0[k], c0##UNIT)); \
391 if (c0##NOT_NA(tmp0)) { \
392 c1##INCREMENT_IDEN(px1[MAP(i)], tmp0); \
393 if (sy && i != j) { \
395 c1##INCREMENT_CONJ(px1[MAP(j)], tmp0); \
397 c1##INCREMENT_IDEN(px1[MAP(j)], tmp0); \
401 px1[MAP(i)] = c1##NA; \
403 px1[MAP(j)] = c1##NA; \
415 for (i = 0; i < nnz1; ++i) \
416 c1##DIVIDE(px1[i], n); \
418 for (i = 0; i < nnz1; ++i) \
419 c1##DIVIDE(px1[i], count[i]); \
424 case 'n':
if (mean)
SUM(n, d);
else SUM(n, i);
break;
425 case 'l':
if (mean)
SUM(l, d);
else SUM(l, i);
break;
426 case 'i':
SUM(i, d);
break;
427 case 'd':
SUM(d, d);
break;
428 case 'z':
SUM(z, z);
break;
434 if (
TYPEOF(ans) != OBJSXP) {
439 int *pi1 = INTEGER(i1);
441 for (i = 0; i < m; ++i)
447 for (i = 0; i < m; ++i)
457 int m,
int n,
char ul,
char ct,
char nu,
459 SEXP ans, SEXP iSym, SEXP jSym)
465 SEXP i0 = PROTECT(
GET_SLOT(obj, iSym)),
467 int *pi0 = INTEGER(i0), *pj0 = INTEGER(j0), i, j, nnz1,
468 *count = NULL, *map = NULL,
469 sy =
class[1] ==
's', he = sy && ct ==
'C',
470 un =
class[1] ==
't' && nu !=
'N';;
471 R_xlen_t k, kend = XLENGTH(i0);
474 if (
TYPEOF(ans) != OBJSXP) {
479 for (j = 0; j < n; ++j)
488 for (k = 0; k < kend; ++k) {
495 for (j = 0; j < n; ++j)
496 map[j] = (map[j]) ? nnz1++ : -1;
499 SEXP j1 = PROTECT(Rf_allocVector(INTSXP, nnz1));
503 for (j = 0; j < nnz1; ++j)
507 PROTECT(x1 = Rf_allocVector(
SUM_TYPEOF(
class[0]), nnz1));
517 SEXP x0 = GET_SLOT(obj, Matrix_xSym); \
518 c0##TYPE *px0 = c0##PTR(x0); \
521 c1##TYPE *px1 = c1##PTR(x1), tmp1 = (un) ? c1##UNIT : c1##ZERO; \
522 for (j = 0; j < nnz1; ++j) \
524 for (k = 0; k < kend; ++k) { \
528 c0##ASSIGN_PROJ_REAL(tmp0, c0##IFELSE_NPATTERN(px0[k], c0##UNIT)); \
530 c0##ASSIGN_IDEN (tmp0, c0##IFELSE_NPATTERN(px0[k], c0##UNIT)); \
531 if (c0##NOT_NA(tmp0)) { \
532 c1##INCREMENT_IDEN(px1[MAP(j)], tmp0); \
533 if (sy && i != j) { \
535 c1##INCREMENT_CONJ(px1[MAP(i)], tmp0); \
537 c1##INCREMENT_IDEN(px1[MAP(i)], tmp0); \
541 px1[MAP(j)] = c1##NA; \
543 px1[MAP(i)] = c1##NA; \
553 for (j = 0; j < nnz1; ++j) \
554 c1##DIVIDE(px1[j], m); \
556 for (j = 0; j < nnz1; ++j) \
557 c1##DIVIDE(px1[j], count[j]); \
562 case 'n':
if (mean)
SUM(n, d);
else SUM(n, i);
break;
563 case 'l':
if (mean)
SUM(l, d);
else SUM(l, i);
break;
564 case 'i':
SUM(i, d);
break;
565 case 'd':
SUM(d, d);
break;
566 case 'z':
SUM(z, z);
break;
572 if (
TYPEOF(ans) != OBJSXP) {
577 int *pj1 = INTEGER(j1);
579 for (j = 0; j < n; ++j)
585 for (j = 0; j < n; ++j)
596 narm = narm &&
class[0] !=
'n';
598 int *pdim =
DIM(obj), m = pdim[0], n = pdim[1],
599 r = (mg == 0) ? m : n;
601 SEXP ans = PROTECT(Rf_allocVector(
SUM_TYPEOF(
class[0]), r)),
604 SEXP dimnames =
DIMNAMES(obj, -(
class[1] ==
's')),
605 marnames = VECTOR_ELT(dimnames, mg);
606 if (marnames != R_NilValue) {
608 Rf_setAttrib(ans, R_NamesSymbol, marnames);
612 char ul =
'\0', ct =
'\0', nu =
'\0';
615 if (
class[1] ==
's' &&
class[0] ==
'z')
620 if (mg == 0 ||
class[1] ==
's')
621 dense_rowsum(x,
class, m, n, ul, ct, nu, narm, mean, ans);
623 dense_colsum(x,
class, m, n, ul, ct, nu, narm, mean, ans);
630 int narm,
int mean,
int sparse)
632 narm = narm &&
class[0] !=
'n';
634 int *pdim =
DIM(obj), m = pdim[0], n = pdim[1],
635 r = (mg == 0) ? m : n;
640 char cl[] =
".sparseVector";
645 INTEGER(length)[0] = r;
647 PROTECT(ans = Rf_allocVector(type, r));
649 SEXP dimnames =
DIMNAMES(obj, -(
class[1] ==
's')),
650 marnames = VECTOR_ELT(dimnames, mg);
651 if (marnames != R_NilValue) {
653 Rf_setAttrib(ans, R_NamesSymbol, marnames);
658 char ul =
'\0', ct =
'\0', nu =
'\0';
661 if (
class[1] ==
's' &&
class[0] ==
'z')
714 SEXP s_narm, SEXP s_mean, SEXP s_sparse)
721 int narm, mean, sparse;
730 SEXP s_narm, SEXP s_mean)
const char * valid_dense[]
#define Matrix_Calloc(p, n, t)
char typeToKind(SEXPTYPE)
const char * Matrix_class(SEXP, const char **, int, const char *)
#define Matrix_Free(p, n)
#define DIMNAMES(x, mode)
#define GET_SLOT(x, name)
SEXP newObject(const char *)
const char * valid_sparse[]
#define SET_SLOT(x, name, value)
#define VALID_LOGIC2(s, d)
#define VALID_MARGIN(s, d)
SEXP dense_marginsum(SEXP obj, const char *class, int mg, int narm, int mean)
static void dense_colsum(SEXP x, const char *class, int m, int n, char ul, char ct, char nu, int narm, int mean, SEXP ans)
SEXP sparse_marginsum(SEXP obj, const char *class, int mg, int narm, int mean, int sparse)
static void Tsparse_colsum(SEXP obj, const char *class, int m, int n, char ul, char ct, char nu, int narm, int mean, SEXP ans, SEXP iSym, SEXP jSym)
SEXP sparse_aggregate(SEXP, const char *)
static void Csparse_colsum(SEXP obj, const char *class, int m, int n, char ul, char ct, char nu, int narm, int mean, SEXP ans)
static void dense_rowsum(SEXP x, const char *class, int m, int n, char ul, char ct, char nu, int narm, int mean, SEXP ans)
SEXP R_sparse_marginsum(SEXP s_obj, SEXP s_margin, SEXP s_narm, SEXP s_mean, SEXP s_sparse)
SEXP R_dense_marginsum(SEXP s_obj, SEXP s_margin, SEXP s_narm, SEXP s_mean)
static void Csparse_rowsum(SEXP obj, const char *class, int m, int n, char ul, char ct, char nu, int narm, int mean, SEXP ans, SEXP iSym)