1 /***********************************************************************
2 TEMPLATE:
3 void colRanges_<int|dbl>(ARGUMENTS_LIST)
4
5 ARGUMENTS_LIST:
6 X_C_TYPE *x, R_xlen_t nrow, R_xlen_t ncol, R_xlen_t *rows, R_xlen_t nrows, R_xlen_t *cols, R_xlen_t ncols, int what, int narm, int hasna, X_C_TYPE *ans, int *is_counted
7
8 Arguments:
9 The following macros ("arguments") should be defined for the
10 template to work as intended.
11
12 - METHOD_NAME: the name of the resulting function
13 - X_TYPE: 'i' or 'r'
14 - ANS_TYPE: 'i' or 'r'
15
16 Authors:
17 Henrik Bengtsson.
18
19 Copyright: Henrik Bengtsson, 2014
20 ***********************************************************************/
21 #include <R_ext/Memory.h>
22 #include "000.types.h"
23
24 /* Expand arguments:
25 X_TYPE => (X_C_TYPE, X_IN_C)
26 ANS_TYPE => (ANS_SXP, ANS_NA, ANS_C_TYPE, ANS_IN_C)
27 */
28 #include "000.templates-types.h"
29
30
CONCAT_MACROS(colRanges,X_C_SIGNATURE)31 void CONCAT_MACROS(colRanges, X_C_SIGNATURE)(X_C_TYPE *x, R_xlen_t nrow, R_xlen_t ncol,
32 R_xlen_t *rows, R_xlen_t nrows, R_xlen_t *cols, R_xlen_t ncols,
33 int what, int narm, int hasna, X_C_TYPE *ans, int *is_counted) {
34 R_xlen_t ii, jj;
35 R_xlen_t colBegin, idx;
36 X_C_TYPE value, *mins = NULL, *maxs = NULL;
37
38 /* Rprintf("(nrow,ncol)=(%d,%d), what=%d\n", nrow, ncol, what); */
39
40 /* If there are no missing values, don't try to remove them. */
41 if (hasna == FALSE)
42 narm = FALSE;
43
44 if (hasna) {
45 for (jj=0; jj < ncols; jj++) is_counted[jj] = 0;
46
47 /* Missing values */
48 if (what == 0) {
49 /* colMins() */
50 mins = ans;
51
52 for (jj=0; jj < ncols; jj++) {
53 colBegin = R_INDEX_OP(((cols == NULL) ? (jj) : cols[jj]), *, nrow);
54
55 for (ii=0; ii < nrows; ii++) {
56 idx = R_INDEX_OP(colBegin, +, ((rows == NULL) ? (ii) : rows[ii]));
57 value = R_INDEX_GET(x, idx, X_NA);
58
59 if (X_ISNAN(value)) {
60 if (!narm) {
61 mins[jj] = value;
62 is_counted[jj] = 1;
63 /* Early stopping? */
64 #if X_TYPE == 'i'
65 break;
66 #elif X_TYPE == 'r'
67 if (X_ISNA(value)) break;
68 #endif
69 }
70 } else if (!is_counted[jj]) {
71 mins[jj] = value;
72 is_counted[jj] = 1;
73 } else if (value < mins[jj]) {
74 mins[jj] = value;
75 }
76 }
77 } /* for (jj ...) */
78
79 #if X_TYPE == 'r'
80 /* Handle zero non-missing values */
81 for (jj=0; jj < ncols; jj++) {
82 if (!is_counted[jj]) {
83 mins[jj] = R_PosInf;
84 }
85 }
86 #endif
87 } else if (what == 1) {
88 /* colMaxs() */
89 maxs = ans;
90
91 for (jj=0; jj < ncols; jj++) {
92 colBegin = R_INDEX_OP(((cols == NULL) ? (jj) : cols[jj]), *, nrow);
93
94 for (ii=0; ii < nrows; ii++) {
95 idx = R_INDEX_OP(colBegin, +, ((rows == NULL) ? (ii) : rows[ii]));
96 value = R_INDEX_GET(x, idx, X_NA);
97
98 if (X_ISNAN(value)) {
99 if (!narm) {
100 maxs[jj] = value;
101 is_counted[jj] = 1;
102 /* Early stopping? */
103 #if X_TYPE == 'i'
104 break;
105 #elif X_TYPE == 'r'
106 if (X_ISNA(value)) break;
107 #endif
108 }
109 } else if (!is_counted[jj]) {
110 maxs[jj] = value;
111 is_counted[jj] = 1;
112 } else if (value > maxs[jj]) {
113 maxs[jj] = value;
114 }
115 }
116 } /* for (jj ...) */
117
118 #if X_TYPE == 'r'
119 /* Handle zero non-missing values */
120 for (jj=0; jj < ncols; jj++) {
121 if (!is_counted[jj]) {
122 maxs[jj] = R_NegInf;
123 }
124 }
125 #endif
126 } else if (what == 2) {
127 /* colRanges() */
128 mins = ans;
129 maxs = &ans[ncols];
130
131 for (jj=0; jj < ncols; jj++) {
132 colBegin = R_INDEX_OP(((cols == NULL) ? (jj) : cols[jj]), *, nrow);
133
134 for (ii=0; ii < nrows; ii++) {
135 idx = R_INDEX_OP(colBegin, +, ((rows == NULL) ? (ii) : rows[ii]));
136 value = R_INDEX_GET(x, idx, X_NA);
137
138 if (X_ISNAN(value)) {
139 if (!narm) {
140 mins[jj] = value;
141 maxs[jj] = value;
142 is_counted[jj] = 1;
143 /* Early stopping? */
144 #if X_TYPE == 'i'
145 break;
146 #elif X_TYPE == 'r'
147 if (X_ISNA(value)) break;
148 #endif
149 }
150 } else if (!is_counted[jj]) {
151 mins[jj] = value;
152 maxs[jj] = value;
153 is_counted[jj] = 1;
154 } else if (value < mins[jj]) {
155 mins[jj] = value;
156 } else if (value > maxs[jj]) {
157 maxs[jj] = value;
158 }
159 }
160 } /* for (jj ...) */
161
162 #if X_TYPE == 'r'
163 /* Handle zero non-missing values */
164 for (jj=0; jj < ncols; jj++) {
165 if (!is_counted[jj]) {
166 mins[jj] = R_PosInf;
167 maxs[jj] = R_NegInf;
168 }
169 }
170 #endif
171 } /* if (what ...) */
172 } else {
173 /* No missing values */
174 if (what == 0) {
175 /* colMins() */
176 mins = ans;
177
178 /* Initiate results */
179 for (jj=0; jj < ncols; jj++) {
180 mins[jj] = x[jj];
181 }
182
183 for (jj=1; jj < ncols; jj++) {
184 colBegin = ((cols == NULL) ? (jj) : cols[jj]) * nrow;
185 for (ii=0; ii < nrows; ii++) {
186 value = x[((rows == NULL) ? (ii) : rows[ii])+colBegin];
187 if (value < mins[jj]) mins[jj] = value;
188 }
189 }
190 } else if (what == 1) {
191 /* colMax() */
192 maxs = ans;
193
194 /* Initiate results */
195 for (jj=0; jj < ncols; jj++) {
196 maxs[jj] = x[jj];
197 }
198
199 for (jj=1; jj < ncols; jj++) {
200 colBegin = ((cols == NULL) ? (jj) : cols[jj]) * nrow;
201 for (ii=0; ii < nrows; ii++) {
202 value = x[((rows == NULL) ? (ii) : rows[ii])+colBegin];
203 if (value > maxs[jj]) maxs[jj] = value;
204 }
205 }
206 } else if (what == 2) {
207 /* colRanges()*/
208 mins = ans;
209 maxs = &ans[ncols];
210
211 /* Initiate results */
212 for (jj=0; jj < ncols; jj++) {
213 mins[jj] = x[jj];
214 maxs[jj] = x[jj];
215 }
216
217 for (jj=1; jj < ncols; jj++) {
218 colBegin = ((cols == NULL) ? (jj) : cols[jj]) * nrow;
219 for (ii=0; ii < nrows; ii++) {
220 value = x[((rows == NULL) ? (ii) : rows[ii])+colBegin];
221 if (value < mins[jj]) {
222 mins[jj] = value;
223 } else if (value > maxs[jj]) {
224 maxs[jj] = value;
225 }
226 }
227 }
228 } /* if (what ...) */
229 } /* if (narm) */
230 }
231
232
233 /***************************************************************************
234 HISTORY:
235 2015-06-07 [DJ]
236 o Supported subsetted computation.
237 2014-11-16 [HB]
238 o Created.
239 **************************************************************************/
240