1 /***********************************************************************
2 TEMPLATE:
3 void rowRanges_<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(rowRanges,X_C_SIGNATURE)31 void CONCAT_MACROS(rowRanges, 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 int *skip = NULL;
38
39 /* Rprintf("(nrow,ncol)=(%d,%d), what=%d\n", nrow, ncol, what); */
40
41 /* If there are no missing values, don't try to remove them. */
42 if (hasna == FALSE)
43 narm = FALSE;
44
45 if (hasna) {
46 skip = (int *) R_alloc(nrows, sizeof(int));
47 for (ii=0; ii < nrows; ii++) {
48 is_counted[ii] = 0;
49 skip[ii] = 0;
50 }
51
52 /* Missing values */
53 if (what == 0) {
54 /* rowMins() */
55 mins = ans;
56
57 for (jj=0; jj < ncols; jj++) {
58 colBegin = R_INDEX_OP(((cols == NULL) ? (jj) : cols[jj]), *, nrow);
59
60 for (ii=0; ii < nrows; ii++) {
61 if (!narm && skip[ii]) continue;
62
63 idx = R_INDEX_OP(colBegin, +, ((rows == NULL) ? (ii) : rows[ii]));
64 value = R_INDEX_GET(x, idx, X_NA);
65
66 if (X_ISNAN(value)) {
67 if (!narm) {
68 mins[ii] = value;
69 is_counted[ii] = 1;
70 /* Early stopping? */
71 #if X_TYPE == 'i'
72 skip[ii] = 1;
73 #elif X_TYPE == 'r'
74 if (X_ISNA(value)) skip[ii] = 1;
75 #endif
76 }
77 } else if (!is_counted[ii]) {
78 mins[ii] = value;
79 is_counted[ii] = 1;
80 } else if (value < mins[ii]) {
81 mins[ii] = value;
82 }
83 }
84 } /* for (jj ...) */
85
86 #if X_TYPE == 'r'
87 /* Handle zero non-missing values */
88 for (ii=0; ii < nrows; ii++) {
89 if (!is_counted[ii]) {
90 mins[ii] = R_PosInf;
91 }
92 }
93 #endif
94 } else if (what == 1) {
95 /* rowMaxs() */
96 maxs = ans;
97
98 for (jj=0; jj < ncols; jj++) {
99 colBegin = R_INDEX_OP(((cols == NULL) ? (jj) : cols[jj]), *, nrow);
100
101 for (ii=0; ii < nrows; ii++) {
102 if (!narm && skip[ii]) continue;
103
104 idx = R_INDEX_OP(colBegin, +, ((rows == NULL) ? (ii) : rows[ii]));
105 value = R_INDEX_GET(x, idx, X_NA);
106
107 if (X_ISNAN(value)) {
108 if (!narm) {
109 maxs[ii] = value;
110 is_counted[ii] = 1;
111 /* Early stopping? */
112 #if X_TYPE == 'i'
113 skip[ii] = 1;
114 #elif X_TYPE == 'r'
115 if (X_ISNA(value)) skip[ii] = 1;
116 #endif
117 }
118 } else if (!is_counted[ii]) {
119 maxs[ii] = value;
120 is_counted[ii] = 1;
121 } else if (value > maxs[ii]) {
122 maxs[ii] = value;
123 }
124 }
125 } /* for (jj ...) */
126
127 #if X_TYPE == 'r'
128 /* Handle zero non-missing values */
129 for (ii=0; ii < nrows; ii++) {
130 if (!is_counted[ii]) {
131 maxs[ii] = R_NegInf;
132 }
133 }
134 #endif
135 } else if (what == 2) {
136 /* rowRanges() */
137 mins = ans;
138 maxs = &ans[nrows];
139
140 for (jj=0; jj < ncols; jj++) {
141 colBegin = R_INDEX_OP(((cols == NULL) ? (jj) : cols[jj]), *, nrow);
142
143 for (ii=0; ii < nrows; ii++) {
144 if (!narm && skip[ii]) continue;
145
146 idx = R_INDEX_OP(colBegin, +, ((rows == NULL) ? (ii) : rows[ii]));
147 value = R_INDEX_GET(x, idx, X_NA);
148
149 if (X_ISNAN(value)) {
150 if (!narm) {
151 mins[ii] = value;
152 maxs[ii] = value;
153 is_counted[ii] = 1;
154 /* Early stopping? */
155 #if X_TYPE == 'i'
156 skip[ii] = 1;
157 #elif X_TYPE == 'r'
158 if (X_ISNA(value)) skip[ii] = 1;
159 #endif
160 }
161 } else if (!is_counted[ii]) {
162 mins[ii] = value;
163 maxs[ii] = value;
164 is_counted[ii] = 1;
165 } else if (value < mins[ii]) {
166 mins[ii] = value;
167 } else if (value > maxs[ii]) {
168 maxs[ii] = value;
169 }
170 }
171 } /* for (jj ...) */
172
173 #if X_TYPE == 'r'
174 /* Handle zero non-missing values */
175 for (ii=0; ii < nrows; ii++) {
176 if (!is_counted[ii]) {
177 mins[ii] = R_PosInf;
178 maxs[ii] = R_NegInf;
179 }
180 }
181 #endif
182 } /* if (what ...) */
183 } else {
184 /* No missing values */
185 if (what == 0) {
186 /* rowMins() */
187 mins = ans;
188
189 /* Initiate results */
190 for (ii=0; ii < nrows; ii++) {
191 mins[ii] = x[ii];
192 }
193
194 for (jj=1; jj < ncols; jj++) {
195 colBegin = ((cols == NULL) ? (jj) : cols[jj]) * nrow;
196 for (ii=0; ii < nrows; ii++) {
197 value = x[((rows == NULL) ? (ii) : rows[ii])+colBegin];
198 if (value < mins[ii]) mins[ii] = value;
199 }
200 }
201 } else if (what == 1) {
202 /* rowMax() */
203 maxs = ans;
204
205 /* Initiate results */
206 for (ii=0; ii < nrows; ii++) {
207 maxs[ii] = x[ii];
208 }
209
210 for (jj=1; jj < ncols; jj++) {
211 colBegin = ((cols == NULL) ? (jj) : cols[jj]) * nrow;
212 for (ii=0; ii < nrows; ii++) {
213 value = x[((rows == NULL) ? (ii) : rows[ii])+colBegin];
214 if (value > maxs[ii]) maxs[ii] = value;
215 }
216 }
217 } else if (what == 2) {
218 /* rowRanges()*/
219 mins = ans;
220 maxs = &ans[nrows];
221
222 /* Initiate results */
223 for (ii=0; ii < nrows; ii++) {
224 mins[ii] = x[ii];
225 maxs[ii] = x[ii];
226 }
227
228 for (jj=1; jj < ncols; jj++) {
229 colBegin = ((cols == NULL) ? (jj) : cols[jj]) * nrow;
230 for (ii=0; ii < nrows; ii++) {
231 value = x[((rows == NULL) ? (ii) : rows[ii])+colBegin];
232 if (value < mins[ii]) {
233 mins[ii] = value;
234 } else if (value > maxs[ii]) {
235 maxs[ii] = value;
236 }
237 }
238 }
239 } /* if (what ...) */
240 } /* if (narm) */
241 }
242
243
244 /***************************************************************************
245 HISTORY:
246 2015-06-07 [DJ]
247 o Supported subsetted computation.
248 2014-11-16 [HB]
249 o Created.
250 **************************************************************************/
251