-
Notifications
You must be signed in to change notification settings - Fork 33
/
rowCounts.c
93 lines (73 loc) · 2.89 KB
/
rowCounts.c
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
/***************************************************************************
Public methods:
SEXP rowCounts(SEXP x, ...)
Copyright Henrik Bengtsson, 2014
**************************************************************************/
#include <Rdefines.h>
#include "types.h"
#include "utils.h"
#define METHOD rowCounts
#define RETURN_TYPE void
#define ARGUMENTS_LIST X_C_TYPE *x, R_xlen_t nrow, R_xlen_t ncol, void *rows, R_xlen_t nrows, void *cols, R_xlen_t ncols, X_C_TYPE value, int what, int narm, int hasna, int *ans, int cores
#define X_TYPE 'i'
#include "templates-gen-matrix.h"
#define X_TYPE 'r'
#include "templates-gen-matrix.h"
#define X_TYPE 'l'
#include "templates-gen-matrix.h"
SEXP rowCounts(SEXP x, SEXP dim, SEXP rows, SEXP cols, SEXP value, SEXP what, SEXP naRm, SEXP hasNA, SEXP cores) {
SEXP ans;
int narm, hasna, what2, cores2;
R_xlen_t nrow, ncol;
/* Argument 'x' & 'dim': */
assertArgMatrix(x, dim, (R_TYPE_LGL | R_TYPE_INT | R_TYPE_REAL), "x");
nrow = asR_xlen_t(dim, 0);
ncol = asR_xlen_t(dim, 1);
/* Argument 'value': */
if (length(value) != 1)
error("Argument 'value' must be a single value.");
if (!isNumeric(value))
error("Argument 'value' must be a numeric value.");
/* Argument 'what': */
what2 = asInteger(what);
if (what2 < 0 || what2 > 2)
error("INTERNAL ERROR: Unknown value of 'what' for rowCounts: %d", what2);
/* Argument 'naRm': */
narm = asLogicalNoNA(naRm, "na.rm");
/* Argument 'hasNA': */
hasna = asLogicalNoNA(hasNA, "hasNA");
/* Argument 'rows' and 'cols': */
R_xlen_t nrows, ncols;
int rowsType, colsType;
void *crows = validateIndices(rows, nrow, 0, &nrows, &rowsType);
void *ccols = validateIndices(cols, ncol, 0, &ncols, &colsType);
#ifdef _USE_PTHREAD_
/* Argument 'cores': */
cores2 = asInteger(cores);
if (cores2 <= 0)
error("Argument 'cores' must be a positive value.");
#else
cores2 = 1;
#endif
/* R allocate a double vector of length 'nrow' */
PROTECT(ans = allocVector(INTSXP, nrows));
/* Double matrices are more common to use. */
if (isReal(x)) {
rowCounts_Real[rowsType][colsType](REAL(x), nrow, ncol, crows, nrows, ccols, ncols, asReal(value), what2, narm, hasna, INTEGER(ans), cores2);
} else if (isInteger(x)) {
rowCounts_Integer[rowsType][colsType](INTEGER(x), nrow, ncol, crows, nrows, ccols, ncols, asInteger(value), what2, narm, hasna, INTEGER(ans), cores2);
} else if (isLogical(x)) {
rowCounts_Logical[rowsType][colsType](LOGICAL(x), nrow, ncol, crows, nrows, ccols, ncols, asLogical(value), what2, narm, hasna, INTEGER(ans), cores2);
}
UNPROTECT(1);
return(ans);
} // rowCounts()
/***************************************************************************
HISTORY:
2015-07-30 [DJ]
o Pthread processing.
2015-04-13 [DJ]
o Supported subsetted computation.
2014-06-02 [HB]
o Created.
**************************************************************************/