1 /***************************************************************************
2
3 Authors: Adopted from rowQuantiles.c by R. Gentleman.
4
5 Copyright Henrik Bengtsson, 2007; Martin Maechler, 2014-2021; History --> EOF
6 **************************************************************************/
7 #include <Rinternals.h>
8 // was #include <Rdefines.h>
9
10 #include "robustbase.h"
11
12 // Public methods:
13
14 SEXP rowMedians_Real (SEXP x, int nrow, int ncol, int narm, int hasna, int byrow);
15 SEXP rowMedians_Integer(SEXP x, int nrow, int ncol, int narm, int hasna, int byrow);
16
17 void C_rowMedians_Real (double* x, double* res,
18 int nrow, int ncol, int narm, int hasna, int byrow);
19 void C_rowMedians_Integer(int* x, double* res,
20 int nrow, int ncol, int narm, int hasna, int byrow);
21 /*
22 TEMPLATE rowMedians_<Integer|Real>(...):
23 - SEXP rowMedians_Real(...);
24 - SEXP rowMedians_Integer(...);
25 */
26 #define METHOD rowMedians
27
28 #define X_TYPE 'i'
29 #include "rowMedians_TYPE-template.h"
30
31 #define X_TYPE 'r'
32 #include "rowMedians_TYPE-template.h"
33
34 #undef METHOD
35
36
37 /* TODO: implement: hasNA in {NA,TRUE,FALSE}; and = NA <==> code should *check*
38
39 R code {for error message}: ../R/comedian.R */
R_rowMedians(SEXP x,SEXP naRm,SEXP hasNA,SEXP byRow,SEXP keepNms)40 SEXP R_rowMedians(SEXP x, SEXP naRm, SEXP hasNA, SEXP byRow, SEXP keepNms) {
41
42 // Argument checking and "C type coercion":
43 if (!isMatrix(x))
44 error(_("Argument 'x' must be a matrix."));
45
46 int narm = asLogical(naRm); // error if it ain't
47 if (narm != TRUE && narm != FALSE)
48 error(_("Argument 'naRm' must be either TRUE or FALSE."));
49
50 int hasna = asLogical(hasNA); // error if it ain't
51 if (hasna == NA_INTEGER)
52 hasna = TRUE;// <- for now; TODO ? become smarter and check
53
54 int byrow = INTEGER(byRow)[0];
55 int keepnms = asLogical(keepNms);
56
57 /* Get dimensions of 'x'. */
58 SEXP ans = PROTECT(getAttrib(x, R_DimSymbol));
59 int nrow, ncol;
60 if (byrow) { // rowMedians
61 nrow = INTEGER(ans)[0];
62 ncol = INTEGER(ans)[1];
63 } else { // colMedians
64 nrow = INTEGER(ans)[1];
65 ncol = INTEGER(ans)[0];
66 }
67 UNPROTECT(1); // and reprotect :
68 if (isReal(x)) {
69 ans = PROTECT(rowMedians_Real (x, nrow, ncol, narm, hasna, byrow));
70 } else if (isInteger(x)) {
71 ans = PROTECT(rowMedians_Integer(x, nrow, ncol, narm, hasna, byrow));
72 } else {
73 error(_("Argument 'x' must be numeric (integer or double)."));
74 }
75 if(keepnms) {
76 SEXP xDnms = getAttrib(x, R_DimNamesSymbol);
77 if(xDnms != R_NilValue) {
78 PROTECT(xDnms);
79 setAttrib(ans, R_NamesSymbol,
80 duplicate(VECTOR_ELT(xDnms, byrow ? 0 : 1)));
81 UNPROTECT(1);
82 }
83 }
84 UNPROTECT(1);
85 return(ans);
86 } /* R_rowMedians() */
87
88
89 /***************************************************************************
90 HISTORY:
91 2014-12-09 [M.Maechler]
92 o Copied to 'robustbase' CRAN package - to replace many apply(*., 2, median)
93 NB: 'Biobase' also contains rowQ = general row/col Quantiles
94 o argument checking all in C
95 o add 'keepNms' argument {and do keep names by default!}
96
97 2013-01-13 [HB]
98 o Added argument 'byRow' to rowMedians() and dropped colMedians().
99 o Using internal arguments 'by_row' instead of 'by_column'.
100 2011-12-11 [HB]
101 o BUG FIX: rowMediansReal(..., na.rm=TRUE) did not handle NaN:s, only NA:s.
102 Note that NaN:s does not exist for integers.
103 2011-10-12 [HJ]
104 o Added colMedians().
105 o Now rowMediansInteger/Real() can operate also by columns, cf. argument
106 'by_column'.
107 2007-08-14 [HB]
108 o Added checks for user interrupts every 1000 line.
109 o Added argument 'hasNA' to rowMedians().
110 2005-12-07 [HB]
111 o BUG FIX: When calculating the median of an even number (non-NA) values,
112 the length of the second sort was one element too short, which made the
113 method to freeze, i.e. rPsort(rowData, qq, qq) is now (...qq+1, qq).
114 2005-11-24 [HB]
115 o By implementing a special version for integers, there is no need to
116 coerce to double in R, which would take up twice the amount of memory.
117 o rowMedians() now handles NAs too.
118 o Adopted from rowQuantiles.c in Biobase of Bioconductor.
119 **************************************************************************/
120