Matrix r5059
Loading...
Searching...
No Matches
colSums.c
Go to the documentation of this file.
1/* C implementation of methods for colSums, colMeans, rowSums, rowMeans */
2
3#include "Mdefines.h"
4#include "M5.h"
5
6/* defined in ./aggregate.c : */
7SEXP sparse_aggregate(SEXP, const char *);
8
9#define SUM_TYPEOF(c) \
10(c == 'z') ? CPLXSXP : (mean || c == 'd' || c == 'i') ? REALSXP : INTSXP
11
12#define MAP(i) (map) ? map[i] : i
13
14#define lCAST(x) (x)
15#define iCAST(x) (x)
16#define dCAST(x) (x)
17#define zCAST(x) (x)
18
19#undef nCAST
20#define nCAST(x) (x != 0)
21
22static
23void dense_colsum(SEXP x, const char *class,
24 int m, int n, char ul, char ct, char nu,
25 int narm, int mean,
26 SEXP ans)
27{
28 int i, j, count = -1, packed = class[2] == 'p';
29
30#define SUM(c0, c1) \
31 do { \
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) { \
36 *px1 = c1##ZERO; \
37 SUM_KERNEL(c0, c1, for (i = 0; i < m; ++i)); \
38 px1 += 1; \
39 } \
40 } else if (nu == 'N') { \
41 if (ul == 'U') \
42 for (j = 0; j < n; ++j) { \
43 *px1 = c1##ZERO; \
44 SUM_KERNEL(c0, c1, for (i = 0; i <= j; ++i)); \
45 if (!packed) \
46 px0 += n - j - 1; \
47 px1 += 1; \
48 } \
49 else \
50 for (j = 0; j < n; ++j) { \
51 *px1 = c1##ZERO; \
52 if (!packed) \
53 px0 += j; \
54 SUM_KERNEL(c0, c1, for (i = j; i < n; ++i)); \
55 px1 += 1; \
56 } \
57 } else { \
58 if (ul == 'U') \
59 for (j = 0; j < n; ++j) { \
60 *px1 = c1##UNIT; \
61 SUM_KERNEL(c0, c1, for (i = 0; i < j; ++i)); \
62 px0 += 1; \
63 if (!packed) \
64 px0 += n - j - 1; \
65 px1 += 1; \
66 } \
67 else \
68 for (j = 0; j < n; ++j) { \
69 *px1 = c1##UNIT; \
70 if (!packed) \
71 px0 += j; \
72 px0 += 1; \
73 SUM_KERNEL(c0, c1, for (i = j + 1; i < n; ++i)); \
74 px1 += 1; \
75 } \
76 } \
77 } while (0)
78
79#define SUM_KERNEL(c0, c1, __for__) \
80 do { \
81 if (mean) \
82 count = m; \
83 __for__ { \
84 if (c0##NOT_NA(*px0)) \
85 c1##INCREMENT_IDEN(*px1, c0##CAST(*px0)); \
86 else if (!narm) \
87 *px1 = c1##NA; \
88 else if (mean) \
89 --count; \
90 px0 += 1; \
91 } \
92 if (mean) \
93 c1##DIVIDE(*px1, count); \
94 } while (0)
95
96 switch (class[0]) {
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;
102 default: break;
103 }
104
105#undef SUM
106#undef SUM_KERNEL
107
108 return;
109}
110
111static
112void dense_rowsum(SEXP x, const char *class,
113 int m, int n, char ul, char ct, char nu,
114 int narm, int mean,
115 SEXP ans)
116{
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';
120
121 if (mean && narm) {
122 Matrix_Calloc(count, m, int);
123 for (i = 0; i < m; ++i)
124 count[i] = n;
125 }
126
127#define SUM(c0, c1) \
128 do { \
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) \
132 px1[i] = tmp1; \
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') { \
137 if (ul == 'U') \
138 for (j = 0; j < n; ++j) { \
139 SUM_KERNEL(c0, c1, for (i = 0; i <= j; ++i)); \
140 if (!packed) \
141 px0 += n - j - 1; \
142 } \
143 else \
144 for (j = 0; j < n; ++j) { \
145 if (!packed) \
146 px0 += j; \
147 SUM_KERNEL(c0, c1, for (i = j; i < n; ++i)); \
148 } \
149 } else { \
150 if (ul == 'U') \
151 for (j = 0; j < n; ++j) { \
152 SUM_KERNEL(c0, c1, for (i = 0; i < j; ++i)); \
153 px0 += 1; \
154 if (!packed) \
155 px0 += n - j - 1; \
156 } \
157 else \
158 for (j = 0; j < n; ++j) { \
159 if (!packed) \
160 px0 += j; \
161 px0 += 1; \
162 SUM_KERNEL(c0, c1, for (i = j + 1; i < n; ++i)); \
163 } \
164 } \
165 if (mean) { \
166 if (!narm) \
167 for (i = 0; i < m; ++i) \
168 c1##DIVIDE(px1[i], n); \
169 else \
170 for (i = 0; i < m; ++i) \
171 c1##DIVIDE(px1[i], count[i]); \
172 } \
173 } while (0)
174
175#define SUM_KERNEL(c0, c1, __for__) \
176 do { \
177 __for__ { \
178 if (he && i == j) \
179 c0##ASSIGN_PROJ_REAL(tmp0, *px0); \
180 else \
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) { \
185 if (he) \
186 c1##INCREMENT_CONJ(px1[j], c0##CAST(tmp0)); \
187 else \
188 c1##INCREMENT_IDEN(px1[j], c0##CAST(tmp0)); \
189 } \
190 } else if (!narm) { \
191 px1[i] = c1##NA; \
192 if (sy && i != j) \
193 px1[j] = c1##NA; \
194 } else if (mean) { \
195 --count[i]; \
196 if (sy && i != j) \
197 --count[j]; \
198 } \
199 px0 += 1; \
200 } \
201 } while (0)
202
203 switch (class[0]) {
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;
209 default: break;
210 }
211
212#undef SUM
213#undef SUM_KERNEL
214
215 if (mean && narm)
216 Matrix_Free(count, m);
217 return;
218}
219
220#undef nCAST
221#define nCAST(x) (1)
222
223static
224void Csparse_colsum(SEXP obj, const char *class,
225 int m, int n, char ul, char ct, char nu,
226 int narm, int mean,
227 SEXP ans)
228{
229 SEXP p0 = PROTECT(GET_SLOT(obj, Matrix_pSym));
230 int *pp0 = INTEGER(p0), j, k, kend, nnz1, count = -1,
231 un = class[1] == 't' && nu != 'N';
232 pp0++;
233
234 SEXP x1;
235 if (TYPEOF(ans) != OBJSXP) {
236 nnz1 = n;
237 x1 = ans;
238 } else {
239 if (un)
240 nnz1 = n;
241 else {
242 nnz1 = 0;
243 for (j = 0; j < n; ++j)
244 if (pp0[j - 1] < pp0[j])
245 ++nnz1;
246 }
247
248 SEXP j1 = PROTECT(Rf_allocVector(INTSXP, nnz1));
249 int *pj1 = INTEGER(j1);
250 SET_SLOT(ans, Matrix_iSym, j1);
251 if (un)
252 for (j = 0; j < n; ++j)
253 *(pj1++) = j + 1;
254 else
255 for (j = 0; j < n; ++j)
256 if (pp0[j - 1] < pp0[j])
257 *(pj1++) = j + 1;
258
259 PROTECT(x1 = Rf_allocVector(SUM_TYPEOF(class[0]), nnz1));
260 SET_SLOT(ans, Matrix_xSym, x1);
261
262 UNPROTECT(2); /* x1, j1 */
263 }
264 PROTECT(x1);
265
266 int full = nnz1 == n;
267
268#define SUM(c0, c1) \
269 do { \
270 c0##IF_NPATTERN( \
271 SEXP x0 = GET_SLOT(obj, Matrix_xSym); \
272 c0##TYPE *px0 = c0##PTR(x0); \
273 ); \
274 c1##TYPE *px1 = c1##PTR(x1), tmp1 = (un) ? c1##UNIT : c1##ZERO; \
275 for (j = 0, k = 0; j < n; ++j) { \
276 kend = pp0[j]; \
277 if (full || k < kend) { \
278 *px1 = tmp1; \
279 if (mean) \
280 count = m; \
281 while (k < kend) { \
282 if (c0##NOT_NA(*px0)) \
283 c1##INCREMENT_IDEN(*px1, c0##CAST(*px0)); \
284 else if (!narm) \
285 *px1 = c1##NA; \
286 else if (mean) \
287 --count; \
288 c0##IF_NPATTERN( \
289 ++px0; \
290 ); \
291 ++k; \
292 } \
293 if (mean) \
294 c1##DIVIDE(*px1, count); \
295 ++px1; \
296 } \
297 } \
298 } while (0)
299
300 switch (class[0]) {
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;
306 default: break;
307 }
308
309#undef SUM
310
311 UNPROTECT(2); /* x1, p0 */
312 return;
313}
314
315static
316void Csparse_rowsum(SEXP obj, const char *class,
317 int m, int n, char ul, char ct, char nu,
318 int narm, int mean,
319 SEXP ans, SEXP iSym)
320{
321 SEXP p0 = PROTECT(GET_SLOT(obj, Matrix_pSym)),
322 i0 = PROTECT(GET_SLOT(obj, iSym));
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';
327 pp0++;
328
329 SEXP x1;
330 if (TYPEOF(ans) != OBJSXP) {
331 nnz1 = m;
332 x1 = ans;
333 if (narm && mean) {
334 Matrix_Calloc(count, m, int);
335 for (i = 0; i < m; ++i)
336 count[i] = n;
337 }
338 } else {
339 if (un)
340 nnz1 = m;
341 else {
342 nnz1 = 0;
343 Matrix_Calloc(map, m, int);
344 for (j = 0, k = 0; j < n; ++j) {
345 kend = pp0[j];
346 while (k < kend) {
347 i = pi0[k];
348 ++map[i];
349 if (sy && i != j)
350 ++map[j];
351 ++k;
352 }
353 }
354 for (i = 0; i < m; ++i)
355 map[i] = (map[i]) ? nnz1++ : -1;
356 }
357
358 SEXP i1 = PROTECT(Rf_allocVector(INTSXP, nnz1));
359 SET_SLOT(ans, Matrix_iSym, i1);
360 if (narm && mean) {
361 count = INTEGER(i1);
362 for (i = 0; i < nnz1; ++i)
363 count[i] = n;
364 }
365
366 PROTECT(x1 = Rf_allocVector(SUM_TYPEOF(class[0]), nnz1));
367 SET_SLOT(ans, Matrix_xSym, x1);
368
369 UNPROTECT(2); /* x1, i1 */
370 }
371 PROTECT(x1);
372
373#define SUM(c0, c1) \
374 do { \
375 c0##IF_NPATTERN( \
376 SEXP x0 = GET_SLOT(obj, Matrix_xSym); \
377 c0##TYPE *px0 = c0##PTR(x0); \
378 ); \
379 c0##TYPE tmp0; \
380 c1##TYPE *px1 = c1##PTR(x1), tmp1 = (un) ? c1##UNIT : c1##ZERO; \
381 for (i = 0; i < nnz1; ++i) \
382 px1[i] = tmp1; \
383 for (j = 0, k = 0; j < n; ++j) { \
384 kend = pp0[j]; \
385 while (k < kend) { \
386 i = pi0[k]; \
387 if (he && i == j) \
388 c0##ASSIGN_PROJ_REAL(tmp0, c0##IFELSE_NPATTERN(px0[k], c0##UNIT)); \
389 else \
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) { \
394 if (he) \
395 c1##INCREMENT_CONJ(px1[MAP(j)], tmp0); \
396 else \
397 c1##INCREMENT_IDEN(px1[MAP(j)], tmp0); \
398 } \
399 } \
400 else if (!narm) { \
401 px1[MAP(i)] = c1##NA; \
402 if (sy && i != j) \
403 px1[MAP(j)] = c1##NA; \
404 } \
405 else if (mean) { \
406 --count[MAP(i)]; \
407 if (sy && i != j) \
408 --count[MAP(j)]; \
409 } \
410 ++k; \
411 } \
412 } \
413 if (mean) { \
414 if (!narm) \
415 for (i = 0; i < nnz1; ++i) \
416 c1##DIVIDE(px1[i], n); \
417 else \
418 for (i = 0; i < nnz1; ++i) \
419 c1##DIVIDE(px1[i], count[i]); \
420 } \
421 } while (0)
422
423 switch (class[0]) {
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;
429 default: break;
430 }
431
432#undef SUM
433
434 if (TYPEOF(ans) != OBJSXP) {
435 if (count)
436 Matrix_Free(count, m);
437 } else {
438 SEXP i1 = GET_SLOT(ans, Matrix_iSym);
439 int *pi1 = INTEGER(i1);
440 if (map) {
441 for (i = 0; i < m; ++i)
442 if (map[i] >= 0)
443 pi1[map[i]] = i + 1;
444 Matrix_Free(map, m);
445 }
446 else
447 for (i = 0; i < m; ++i)
448 pi1[i] = i + 1;
449 }
450
451 UNPROTECT(3); /* x1, i0, p0 */
452 return;
453}
454
455static
456void Tsparse_colsum(SEXP obj, const char *class,
457 int m, int n, char ul, char ct, char nu,
458 int narm, int mean,
459 SEXP ans, SEXP iSym, SEXP jSym)
460{
461 if (narm && mean)
462 obj = sparse_aggregate(obj, class);
463 PROTECT(obj);
464
465 SEXP i0 = PROTECT(GET_SLOT(obj, iSym)),
466 j0 = PROTECT(GET_SLOT(obj, jSym));
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);
472
473 SEXP x1;
474 if (TYPEOF(ans) != OBJSXP) {
475 nnz1 = n;
476 x1 = ans;
477 if (narm && mean) {
478 Matrix_Calloc(count, n, int);
479 for (j = 0; j < n; ++j)
480 count[j] = m;
481 }
482 } else {
483 if (un)
484 nnz1 = n;
485 else {
486 nnz1 = 0;
487 Matrix_Calloc(map, n, int);
488 for (k = 0; k < kend; ++k) {
489 i = pi0[k];
490 j = pj0[k];
491 ++map[j];
492 if (sy && i != j)
493 ++map[i];
494 }
495 for (j = 0; j < n; ++j)
496 map[j] = (map[j]) ? nnz1++ : -1;
497 }
498
499 SEXP j1 = PROTECT(Rf_allocVector(INTSXP, nnz1));
500 SET_SLOT(ans, Matrix_iSym, j1);
501 if (narm && mean) {
502 count = INTEGER(j1);
503 for (j = 0; j < nnz1; ++j)
504 count[j] = m;
505 }
506
507 PROTECT(x1 = Rf_allocVector(SUM_TYPEOF(class[0]), nnz1));
508 SET_SLOT(ans, Matrix_xSym, x1);
509
510 UNPROTECT(2); /* x1, j1 */
511 }
512 PROTECT(x1);
513
514#define SUM(c0, c1) \
515 do { \
516 c0##IF_NPATTERN( \
517 SEXP x0 = GET_SLOT(obj, Matrix_xSym); \
518 c0##TYPE *px0 = c0##PTR(x0); \
519 ); \
520 c0##TYPE tmp0; \
521 c1##TYPE *px1 = c1##PTR(x1), tmp1 = (un) ? c1##UNIT : c1##ZERO; \
522 for (j = 0; j < nnz1; ++j) \
523 px1[j] = tmp1; \
524 for (k = 0; k < kend; ++k) { \
525 i = pi0[k]; \
526 j = pj0[k]; \
527 if (he && i == j) \
528 c0##ASSIGN_PROJ_REAL(tmp0, c0##IFELSE_NPATTERN(px0[k], c0##UNIT)); \
529 else \
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) { \
534 if (he) \
535 c1##INCREMENT_CONJ(px1[MAP(i)], tmp0); \
536 else \
537 c1##INCREMENT_IDEN(px1[MAP(i)], tmp0); \
538 } \
539 } \
540 else if (!narm) { \
541 px1[MAP(j)] = c1##NA; \
542 if (sy && i != j) \
543 px1[MAP(i)] = c1##NA; \
544 } \
545 else if (mean) { \
546 --count[MAP(j)]; \
547 if (sy && i != j) \
548 --count[MAP(i)]; \
549 } \
550 } \
551 if (mean) { \
552 if (!narm) \
553 for (j = 0; j < nnz1; ++j) \
554 c1##DIVIDE(px1[j], m); \
555 else \
556 for (j = 0; j < nnz1; ++j) \
557 c1##DIVIDE(px1[j], count[j]); \
558 } \
559 } while (0)
560
561 switch (class[0]) {
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;
567 default: break;
568 }
569
570#undef SUM
571
572 if (TYPEOF(ans) != OBJSXP) {
573 if (count)
574 Matrix_Free(count, n);
575 } else {
576 SEXP j1 = GET_SLOT(ans, Matrix_iSym);
577 int *pj1 = INTEGER(j1);
578 if (map) {
579 for (j = 0; j < n; ++j)
580 if (map[j] >= 0)
581 pj1[map[j]] = j + 1;
582 Matrix_Free(map, n);
583 }
584 else
585 for (j = 0; j < n; ++j)
586 pj1[j] = j + 1;
587 }
588
589 UNPROTECT(4); /* x1, j0, i0, obj */
590 return;
591}
592
593SEXP dense_marginsum(SEXP obj, const char *class, int mg,
594 int narm, int mean)
595{
596 narm = narm && class[0] != 'n';
597
598 int *pdim = DIM(obj), m = pdim[0], n = pdim[1],
599 r = (mg == 0) ? m : n;
600
601 SEXP ans = PROTECT(Rf_allocVector(SUM_TYPEOF(class[0]), r)),
602 x = PROTECT(GET_SLOT(obj, Matrix_xSym));
603
604 SEXP dimnames = DIMNAMES(obj, -(class[1] == 's')),
605 marnames = VECTOR_ELT(dimnames, mg);
606 if (marnames != R_NilValue) {
607 PROTECT(marnames);
608 Rf_setAttrib(ans, R_NamesSymbol, marnames);
609 UNPROTECT(1); /* marnames */
610 }
611
612 char ul = '\0', ct = '\0', nu = '\0';
613 if (class[1] != 'g')
614 ul = UPLO(obj);
615 if (class[1] == 's' && class[0] == 'z')
616 ct = TRANS(obj);
617 if (class[1] == 't')
618 nu = DIAG(obj);
619
620 if (mg == 0 || class[1] == 's')
621 dense_rowsum(x, class, m, n, ul, ct, nu, narm, mean, ans);
622 else
623 dense_colsum(x, class, m, n, ul, ct, nu, narm, mean, ans);
624
625 UNPROTECT(2); /* x, ans */
626 return ans;
627}
628
629SEXP sparse_marginsum(SEXP obj, const char *class, int mg,
630 int narm, int mean, int sparse)
631{
632 narm = narm && class[0] != 'n';
633
634 int *pdim = DIM(obj), m = pdim[0], n = pdim[1],
635 r = (mg == 0) ? m : n;
636
637 SEXP ans;
638 SEXPTYPE type = SUM_TYPEOF(class[0]);
639 if (sparse) {
640 char cl[] = ".sparseVector";
641 cl[0] = typeToKind(type);
642 PROTECT(ans = newObject(cl));
643
644 SEXP length = GET_SLOT(ans, Matrix_lengthSym);
645 INTEGER(length)[0] = r;
646 } else {
647 PROTECT(ans = Rf_allocVector(type, r));
648
649 SEXP dimnames = DIMNAMES(obj, -(class[1] == 's')),
650 marnames = VECTOR_ELT(dimnames, mg);
651 if (marnames != R_NilValue) {
652 PROTECT(marnames);
653 Rf_setAttrib(ans, R_NamesSymbol, marnames);
654 UNPROTECT(1); /* marnames */
655 }
656 }
657
658 char ul = '\0', ct = '\0', nu = '\0';
659 if (class[1] != 'g')
660 ul = UPLO(obj);
661 if (class[1] == 's' && class[0] == 'z')
662 ct = TRANS(obj);
663 if (class[1] == 't')
664 nu = DIAG(obj);
665
666 if (mg == 0)
667 switch (class[2]) {
668 case 'C':
669 Csparse_rowsum(obj, class, m, n, ul, ct, nu, narm, mean,
670 ans, Matrix_iSym);
671 break;
672 case 'R':
673 if (class[1] == 's')
674 Csparse_rowsum(obj, class, n, m, ul, ct, nu, narm, mean,
675 ans, Matrix_jSym);
676 else
677 Csparse_colsum(obj, class, n, m, ul, ct, nu, narm, mean,
678 ans);
679 break;
680 case 'T':
681 Tsparse_colsum(obj, class, n, m, ul, ct, nu, narm, mean,
682 ans, Matrix_jSym, Matrix_iSym);
683 break;
684 default:
685 break;
686 }
687 else
688 switch (class[2]) {
689 case 'C':
690 if (class[1] == 's')
691 Csparse_rowsum(obj, class, m, n, ul, ct, nu, narm, mean,
692 ans, Matrix_iSym);
693 else
694 Csparse_colsum(obj, class, m, n, ul, ct, nu, narm, mean,
695 ans);
696 break;
697 case 'R':
698 Csparse_rowsum(obj, class, n, m, ul, ct, nu, narm, mean,
699 ans, Matrix_jSym);
700 break;
701 case 'T':
702 Tsparse_colsum(obj, class, m, n, ul, ct, nu, narm, mean,
703 ans, Matrix_iSym, Matrix_jSym);
704 break;
705 default:
706 break;
707 }
708
709 UNPROTECT(1); /* ans */
710 return ans;
711}
712
713SEXP R_sparse_marginsum(SEXP s_obj, SEXP s_margin,
714 SEXP s_narm, SEXP s_mean, SEXP s_sparse)
715{
716 const char *class = Matrix_class(s_obj, valid_sparse, 6, __func__);
717
718 int mg;
719 VALID_MARGIN(s_margin, mg);
720
721 int narm, mean, sparse;
722 VALID_LOGIC2(s_narm , narm );
723 VALID_LOGIC2(s_mean , mean );
724 VALID_LOGIC2(s_sparse, sparse);
725
726 return sparse_marginsum(s_obj, class, mg, narm, mean, sparse);
727}
728
729SEXP R_dense_marginsum(SEXP s_obj, SEXP s_margin,
730 SEXP s_narm, SEXP s_mean)
731{
732 const char *class = Matrix_class(s_obj, valid_dense, 6, __func__);
733
734 int mg;
735 VALID_MARGIN(s_margin, mg);
736
737 int narm, mean;
738 VALID_LOGIC2(s_narm, narm);
739 VALID_LOGIC2(s_mean, mean);
740
741 return dense_marginsum(s_obj, class, mg, narm, mean);
742}
valid_dense
const char * valid_dense[]
Definition objects.c:3
Matrix_Calloc
#define Matrix_Calloc(p, n, t)
Definition Mdefines.h:45
DIAG
#define DIAG(x)
Definition Mdefines.h:111
UPLO
#define UPLO(x)
Definition Mdefines.h:101
typeToKind
char typeToKind(SEXPTYPE)
Definition objects.c:20
Matrix_class
const char * Matrix_class(SEXP, const char **, int, const char *)
Definition objects.c:112
Matrix_Free
#define Matrix_Free(p, n)
Definition Mdefines.h:56
DIMNAMES
#define DIMNAMES(x, mode)
Definition Mdefines.h:96
TRANS
#define TRANS(x)
Definition Mdefines.h:106
DIM
#define DIM(x)
Definition Mdefines.h:85
GET_SLOT
#define GET_SLOT(x, name)
Definition Mdefines.h:72
newObject
SEXP newObject(const char *)
Definition objects.c:13
valid_sparse
const char * valid_sparse[]
Definition Mdefines.h:328
SET_SLOT
#define SET_SLOT(x, name, value)
Definition Mdefines.h:73
VALID_LOGIC2
#define VALID_LOGIC2(s, d)
Definition Mdefines.h:216
TYPEOF
#define TYPEOF(s)
Definition Mdefines.h:123
VALID_MARGIN
#define VALID_MARGIN(s, d)
Definition Mdefines.h:209
cl
cholmod_common cl
Definition cholmod-etc.c:6
SUM
#define SUM(c0, c1)
dense_marginsum
SEXP dense_marginsum(SEXP obj, const char *class, int mg, int narm, int mean)
Definition colSums.c:593
SUM_TYPEOF
#define SUM_TYPEOF(c)
Definition colSums.c:9
dense_colsum
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)
Definition colSums.c:23
sparse_marginsum
SEXP sparse_marginsum(SEXP obj, const char *class, int mg, int narm, int mean, int sparse)
Definition colSums.c:629
Tsparse_colsum
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)
Definition colSums.c:456
sparse_aggregate
SEXP sparse_aggregate(SEXP, const char *)
Definition aggregate.c:5
Csparse_colsum
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)
Definition colSums.c:224
dense_rowsum
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)
Definition colSums.c:112
R_sparse_marginsum
SEXP R_sparse_marginsum(SEXP s_obj, SEXP s_margin, SEXP s_narm, SEXP s_mean, SEXP s_sparse)
Definition colSums.c:713
R_dense_marginsum
SEXP R_dense_marginsum(SEXP s_obj, SEXP s_margin, SEXP s_narm, SEXP s_mean)
Definition colSums.c:729
Csparse_rowsum
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)
Definition colSums.c:316
Matrix_xSym
SEXP Matrix_xSym
Definition init.c:635
Matrix_lengthSym
SEXP Matrix_lengthSym
Definition init.c:612
Matrix_iSym
SEXP Matrix_iSym
Definition init.c:607
Matrix_jSym
SEXP Matrix_jSym
Definition init.c:610
Matrix_pSym
SEXP Matrix_pSym
Definition init.c:622
Generated by doxygen 1.12.0