-
Notifications
You must be signed in to change notification settings - Fork 33
/
rowOrderStats.c
108 lines (89 loc) · 3.4 KB
/
rowOrderStats.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
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
/***************************************************************************
Public methods:
SEXP rowOrderStats(SEXP x, SEXP dim, SEXP rows, SEXP cols, SEXP which, SEXP cores)
Authors: Henrik Bengtsson. Adopted from rowQ() by R. Gentleman.
To do: Add support for missing values.
Copyright Henrik Bengtsson, 2007-2014
**************************************************************************/
#include <Rdefines.h>
#include "types.h"
#include "utils.h"
#define METHOD rowOrderStats
#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, R_xlen_t qq, X_C_TYPE *ans, int cores
#define X_TYPE 'i'
#include "templates-gen-matrix.h"
#define X_TYPE 'r'
#include "templates-gen-matrix.h"
SEXP rowOrderStats(SEXP x, SEXP dim,SEXP rows, SEXP cols, SEXP which, SEXP cores) {
SEXP ans = NILSXP;
R_xlen_t nrow, ncol, qq;
int cores2;
/* Argument 'x' and 'dim': */
assertArgMatrix(x, dim, (R_TYPE_INT | R_TYPE_REAL), "x");
nrow = asR_xlen_t(dim, 0);
ncol = asR_xlen_t(dim, 1);
/* Argument 'which': */
if (length(which) != 1)
error("Argument 'which' must be a single number.");
if (!isNumeric(which))
error("Argument 'which' must be a numeric number.");
/* Argument 'rows' and 'cols': */
R_xlen_t nrows, ncols;
int rowsType, colsType;
int rowsHasna, colsHasna;
void *crows = validateIndicesCheckNA(rows, nrow, 0, &nrows, &rowsType, &rowsHasna);
void *ccols = validateIndicesCheckNA(cols, ncol, 0, &ncols, &colsType, &colsHasna);
// Check missing rows
if (rowsHasna && ncols > 0) {
error("Argument 'rows' must not contain missing value");
}
// Check missing cols
if (colsHasna && nrows > 0) {
error("Argument 'cols' must not contain missing value");
}
/* Subtract one here, since rPsort does zero based addressing */
qq = asInteger(which) - 1;
/* Assert that 'qq' is a valid index */
if (qq < 0 || qq >= ncols) {
error("Argument 'which' is out of range.");
}
#ifdef _USE_PTHREAD_
/* Argument 'cores': */
cores2 = asInteger(cores);
if (cores2 <= 0)
error("Argument 'cores' must be a positive value.");
#else
cores2 = 1;
#endif
/* Double matrices are more common to use. */
if (isReal(x)) {
PROTECT(ans = allocVector(REALSXP, nrows));
rowOrderStats_Real[rowsType][colsType](REAL(x), nrow, ncol, crows, nrows, ccols, ncols, qq, REAL(ans), cores2);
UNPROTECT(1);
} else if (isInteger(x)) {
PROTECT(ans = allocVector(INTSXP, nrows));
rowOrderStats_Integer[rowsType][colsType](INTEGER(x), nrow, ncol, crows, nrows, ccols, ncols, qq, INTEGER(ans), cores2);
UNPROTECT(1);
}
return(ans);
} // rowOrderStats()
/***************************************************************************
HISTORY:
2015-08-09 [DJ]
o Pthread processing.
2015-07-11 [DJ]
o Supported subsetted computation.
2009-02-04 [HB]
o BUG FIX: For some errors in rowOrderStats(), the stack would not become
UNPROTECTED before calling error.
2008-03-25 [HB]
o Renamed from 'rowQuantiles' to 'rowOrderStats'.
2007-08-10 [HB]
o Removed arguments for NAs since rowOrderStats() still don't support it.
2005-11-24 [HB]
o Cool, it works and compiles nicely.
o Preallocate colOffset to speed up things even more.
o Added more comments and error checking.
o Adopted from rowQ() in Biobase of Bioconductor.
**************************************************************************/