1 /*
2 # Fast methods for sorted integers
3 # (c) 2016 - 2017 Jens Oehlschägel
4 # Licence: GPL2
5 # Provided 'as is', use at your own risk
6 */
7
8 #include "merge.h"
9
10 #define REV_A
11 #define REV_B
12 #include "merge.c.h"
13 #include "range.c.h"
14
15 #undef REV_A
16 #include "merge.c.h"
17 #include "range.c.h"
18
19 #define REV_A
20 #undef REV_B
21 #include "merge.c.h"
22 #include "range.c.h"
23
24 #undef REV_A
25 #include "merge.c.h"
26 #include "range.c.h"
27
R_merge_rev(SEXP x_)28 SEXP R_merge_rev(SEXP x_){
29 SEXP y_;
30 int i, j, n=LENGTH(x_);
31 int *intx, *inty;
32 double *realx, *realy;
33 switch(TYPEOF(x_)) {
34 case REALSXP:
35 PROTECT( y_ = allocVector(REALSXP,n) );
36 realx = REAL(x_);
37 realy = REAL(y_);
38 for (i=0,j=n-1;i<n;i++,j--)
39 realy[i] = -realx[j];
40 break;
41 case LGLSXP:
42 PROTECT( y_ = allocVector(LGLSXP,n) );
43 intx = LOGICAL(x_);
44 inty = LOGICAL(y_);
45 for (i=0,j=n-1;i<n;i++,j--)
46 inty[i] = TRUE - intx[j];
47 break;
48 case INTSXP:
49 PROTECT( y_ = allocVector(INTSXP,n) );
50 intx = INTEGER(x_);
51 inty = INTEGER(y_);
52 for (i=0,j=n-1;i<n;i++,j--)
53 inty[i] = -intx[j];
54 break;
55 case CPLXSXP:
56 case STRSXP:
57 default:
58 error("non-implemented type in merge_rev");
59 }
60 UNPROTECT(1);
61 return(y_);
62 }
63
R_merge_match(SEXP x_,SEXP y_,SEXP revx_,SEXP revy_,SEXP nomatch_)64 SEXP R_merge_match(SEXP x_, SEXP y_, SEXP revx_, SEXP revy_, SEXP nomatch_){
65 int *x = INTEGER(x_);
66 int *y = INTEGER(y_);
67 int nx = LENGTH(x_);
68 int ny = LENGTH(y_);
69 int nomatch = asInteger(nomatch_);
70 SEXP ret_;
71 PROTECT( ret_ = allocVector(INTSXP,nx) );
72 int *ret = INTEGER(ret_);
73 if (asLogical(revx_)){
74 if (asLogical(revy_))
75 int_merge_match_revab((ValueT *)x,nx,(ValueT *)y,ny,(ValueT *)ret, nomatch);
76 else
77 int_merge_match_reva((ValueT *)x,nx,(ValueT *)y,ny,(ValueT *)ret, nomatch);
78 }else{
79 if (asLogical(revy_))
80 int_merge_match_revb((ValueT *)x,nx,(ValueT *)y,ny,(ValueT *)ret, nomatch);
81 else
82 int_merge_match((ValueT *)x,nx,(ValueT *)y,ny,(ValueT *)ret, nomatch);
83 }
84
85 UNPROTECT(1);
86 return(ret_);
87 }
88
R_merge_in(SEXP x_,SEXP y_,SEXP revx_,SEXP revy_)89 SEXP R_merge_in(SEXP x_, SEXP y_, SEXP revx_, SEXP revy_){
90 int *x = INTEGER(x_);
91 int *y = INTEGER(y_);
92 int nx = LENGTH(x_);
93 int ny = LENGTH(y_);
94 SEXP ret_;
95 PROTECT( ret_ = allocVector(LGLSXP,nx) );
96 int *ret = LOGICAL(ret_);
97 if (asLogical(revx_)){
98 if (asLogical(revy_))
99 int_merge_in_revab((ValueT *)x,nx,(ValueT *)y,ny,(ValueT *)ret);
100 else
101 int_merge_in_reva((ValueT *)x,nx,(ValueT *)y,ny,(ValueT *)ret);
102 }else{
103 if (asLogical(revy_))
104 int_merge_in_revb((ValueT *)x,nx,(ValueT *)y,ny,(ValueT *)ret);
105 else
106 int_merge_in((ValueT *)x,nx,(ValueT *)y,ny,(ValueT *)ret);
107 }
108
109 UNPROTECT(1);
110 return(ret_);
111 }
112
R_merge_notin(SEXP x_,SEXP y_,SEXP revx_,SEXP revy_)113 SEXP R_merge_notin(SEXP x_, SEXP y_, SEXP revx_, SEXP revy_){
114 int *x = INTEGER(x_);
115 int *y = INTEGER(y_);
116 int nx = LENGTH(x_);
117 int ny = LENGTH(y_);
118 SEXP ret_;
119 PROTECT( ret_ = allocVector(LGLSXP,nx) );
120 int *ret = LOGICAL(ret_);
121 if (asLogical(revx_)){
122 if (asLogical(revy_))
123 int_merge_notin_revab((ValueT *)x,nx,(ValueT *)y,ny,(ValueT *)ret);
124 else
125 int_merge_notin_reva((ValueT *)x,nx,(ValueT *)y,ny,(ValueT *)ret);
126 }else{
127 if (asLogical(revy_))
128 int_merge_notin_revb((ValueT *)x,nx,(ValueT *)y,ny,(ValueT *)ret);
129 else
130 int_merge_notin((ValueT *)x,nx,(ValueT *)y,ny,(ValueT *)ret);
131 }
132
133 UNPROTECT(1);
134 return(ret_);
135 }
136
137
138
R_merge_unique(SEXP x_,SEXP revx_)139 SEXP R_merge_unique(SEXP x_, SEXP revx_){
140 int *x = INTEGER(x_);
141 int nx = LENGTH(x_);
142 int n;
143 SEXP ret_;
144 PROTECT( ret_ = allocVector(INTSXP,nx) );
145 int *ret = INTEGER(ret_);
146 if (asLogical(revx_)){
147 n = int_merge_unique_reva((ValueT *)x,nx,(ValueT *)ret);
148 }else{
149 n = int_merge_unique((ValueT *)x,nx,(ValueT *)ret);
150 }
151 if (n < nx){
152 SETLENGTH(ret_, n);
153 }
154 UNPROTECT(1);
155 return(ret_);
156 }
157
158
R_merge_duplicated(SEXP x_,SEXP revx_)159 SEXP R_merge_duplicated(SEXP x_, SEXP revx_){
160 int *x = INTEGER(x_);
161 int nx = LENGTH(x_);
162 SEXP ret_;
163 PROTECT( ret_ = allocVector(LGLSXP,nx) );
164 int *ret = INTEGER(ret_);
165 if (asLogical(revx_)){
166 int_merge_duplicated_reva((ValueT *)x,nx,(ValueT *)ret);
167 }else{
168 int_merge_duplicated((ValueT *)x,nx,(ValueT *)ret);
169 }
170 UNPROTECT(1);
171 return(ret_);
172 }
173
R_merge_anyDuplicated(SEXP x_,SEXP revx_)174 SEXP R_merge_anyDuplicated(SEXP x_, SEXP revx_){
175 int *x = INTEGER(x_);
176 int nx = LENGTH(x_);
177 SEXP ret_;
178 PROTECT( ret_ = allocVector(LGLSXP,1) );
179 if (asLogical(revx_)){
180 LOGICAL(ret_)[0] = int_merge_anyDuplicated_reva((ValueT *)x,nx);
181 }else{
182 LOGICAL(ret_)[0] = int_merge_anyDuplicated((ValueT *)x,nx);
183 }
184 UNPROTECT(1);
185 return(ret_);
186 }
187
R_merge_sumDuplicated(SEXP x_,SEXP revx_)188 SEXP R_merge_sumDuplicated(SEXP x_, SEXP revx_){
189 int *x = INTEGER(x_);
190 int nx = LENGTH(x_);
191 SEXP ret_;
192 PROTECT( ret_ = allocVector(INTSXP,1) );
193 if (asLogical(revx_)){
194 INTEGER(ret_)[0] = int_merge_sumDuplicated_reva((ValueT *)x,nx);
195 }else{
196 INTEGER(ret_)[0] = int_merge_sumDuplicated((ValueT *)x,nx);
197 }
198 UNPROTECT(1);
199 return(ret_);
200 }
201
202
203
R_merge_union(SEXP x_,SEXP y_,SEXP revx_,SEXP revy_,SEXP method_)204 SEXP R_merge_union(SEXP x_, SEXP y_, SEXP revx_, SEXP revy_, SEXP method_){
205 int *x = INTEGER(x_);
206 int *y = INTEGER(y_);
207 int nx = LENGTH(x_);
208 int ny = LENGTH(y_);
209 SEXP ret_;
210 PROTECT( ret_ = allocVector(INTSXP,nx+ny) );
211 int *ret = INTEGER(ret_);
212 if(strcmp(CHAR(STRING_ELT(method_, 0)), "all") == 0) {
213 if (asLogical(revx_)){
214 if (asLogical(revy_))
215 int_merge_union_all_revab((ValueT *)x,nx,(ValueT *)y,ny,(ValueT *)ret);
216 else
217 int_merge_union_all_reva((ValueT *)x,nx,(ValueT *)y,ny,(ValueT *)ret);
218 }else{
219 if (asLogical(revy_))
220 int_merge_union_all_revb((ValueT *)x,nx,(ValueT *)y,ny,(ValueT *)ret);
221 else
222 int_merge_union_all((ValueT *)x,nx,(ValueT *)y,ny,(ValueT *)ret);
223 }
224 }else{
225 int n;
226 if(strcmp(CHAR(STRING_ELT(method_, 0)), "unique") == 0) {
227 if (asLogical(revx_)){
228 if (asLogical(revy_))
229 n = int_merge_union_unique_revab((ValueT *)x,nx,(ValueT *)y,ny,(ValueT *)ret);
230 else
231 n = int_merge_union_unique_reva((ValueT *)x,nx,(ValueT *)y,ny,(ValueT *)ret);
232 }else{
233 if (asLogical(revy_))
234 n = int_merge_union_unique_revb((ValueT *)x,nx,(ValueT *)y,ny,(ValueT *)ret);
235 else
236 n = int_merge_union_unique((ValueT *)x,nx,(ValueT *)y,ny,(ValueT *)ret);
237 }
238 }else if(strcmp(CHAR(STRING_ELT(method_, 0)), "exact") == 0) {
239 if (asLogical(revx_)){
240 if (asLogical(revy_))
241 n = int_merge_union_exact_revab((ValueT *)x,nx,(ValueT *)y,ny,(ValueT *)ret);
242 else
243 n = int_merge_union_exact_reva((ValueT *)x,nx,(ValueT *)y,ny,(ValueT *)ret);
244 }else{
245 if (asLogical(revy_))
246 n = int_merge_union_exact_revb((ValueT *)x,nx,(ValueT *)y,ny,(ValueT *)ret);
247 else
248 n = int_merge_union_exact((ValueT *)x,nx,(ValueT *)y,ny,(ValueT *)ret);
249 }
250 }else
251 error("illegal method");
252 if (n < (nx+ny)){
253 SETLENGTH(ret_, n);
254 }
255 }
256 UNPROTECT(1);
257 return(ret_);
258 }
259
R_merge_setdiff(SEXP x_,SEXP y_,SEXP revx_,SEXP revy_,SEXP method_)260 SEXP R_merge_setdiff(SEXP x_, SEXP y_, SEXP revx_, SEXP revy_, SEXP method_){
261 int *x = INTEGER(x_);
262 int *y = INTEGER(y_);
263 int nx = LENGTH(x_);
264 int ny = LENGTH(y_);
265 int n;
266 SEXP ret_;
267 PROTECT( ret_ = allocVector(INTSXP,nx) );
268 int *ret = INTEGER(ret_);
269 if(strcmp(CHAR(STRING_ELT(method_, 0)), "unique") == 0) {
270 if (asLogical(revx_)){
271 if (asLogical(revy_))
272 n = int_merge_setdiff_unique_revab((ValueT *)x,nx,(ValueT *)y,ny,(ValueT *)ret);
273 else
274 n = int_merge_setdiff_unique_reva((ValueT *)x,nx,(ValueT *)y,ny,(ValueT *)ret);
275 }else{
276 if (asLogical(revy_))
277 n = int_merge_setdiff_unique_revb((ValueT *)x,nx,(ValueT *)y,ny,(ValueT *)ret);
278 else
279 n = int_merge_setdiff_unique((ValueT *)x,nx,(ValueT *)y,ny,(ValueT *)ret);
280 }
281 }else if(strcmp(CHAR(STRING_ELT(method_, 0)), "exact") == 0) {
282 if (asLogical(revx_)){
283 if (asLogical(revy_))
284 n = int_merge_setdiff_exact_revab((ValueT *)x,nx,(ValueT *)y,ny,(ValueT *)ret);
285 else
286 n = int_merge_setdiff_exact_reva((ValueT *)x,nx,(ValueT *)y,ny,(ValueT *)ret);
287 }else{
288 if (asLogical(revy_))
289 n = int_merge_setdiff_exact_revb((ValueT *)x,nx,(ValueT *)y,ny,(ValueT *)ret);
290 else
291 n = int_merge_setdiff_exact((ValueT *)x,nx,(ValueT *)y,ny,(ValueT *)ret);
292 }
293 }else
294 error("illegal method");
295 if (n < nx){
296 SETLENGTH(ret_, n);
297 }
298 UNPROTECT(1);
299 return(ret_);
300 }
301
R_merge_setequal(SEXP x_,SEXP y_,SEXP revx_,SEXP revy_,SEXP method_)302 SEXP R_merge_setequal(SEXP x_, SEXP y_, SEXP revx_, SEXP revy_, SEXP method_){
303 int *x = INTEGER(x_);
304 int *y = INTEGER(y_);
305 int nx = LENGTH(x_);
306 int ny = LENGTH(y_);
307 SEXP ret_;
308 PROTECT( ret_ = allocVector(LGLSXP,1) );
309 if(strcmp(CHAR(STRING_ELT(method_, 0)), "unique") == 0) {
310 if (asLogical(revx_)){
311 if (asLogical(revy_))
312 LOGICAL(ret_)[0] = int_merge_setequal_unique_revab((ValueT *)x,nx,(ValueT *)y,ny);
313 else
314 LOGICAL(ret_)[0] = int_merge_setequal_unique_reva((ValueT *)x,nx,(ValueT *)y,ny);
315 }else{
316 if (asLogical(revy_))
317 LOGICAL(ret_)[0] = int_merge_setequal_unique_revb((ValueT *)x,nx,(ValueT *)y,ny);
318 else
319 LOGICAL(ret_)[0] = int_merge_setequal_unique((ValueT *)x,nx,(ValueT *)y,ny);
320 }
321 }else if(strcmp(CHAR(STRING_ELT(method_, 0)), "exact") == 0) {
322 if (asLogical(revx_)){
323 if (asLogical(revy_))
324 LOGICAL(ret_)[0] = int_merge_setequal_exact_revab((ValueT *)x,nx,(ValueT *)y,ny);
325 else
326 LOGICAL(ret_)[0] = int_merge_setequal_exact_reva((ValueT *)x,nx,(ValueT *)y,ny);
327 }else{
328 if (asLogical(revy_))
329 LOGICAL(ret_)[0] = int_merge_setequal_exact_revb((ValueT *)x,nx,(ValueT *)y,ny);
330 else
331 LOGICAL(ret_)[0] = int_merge_setequal_exact((ValueT *)x,nx,(ValueT *)y,ny);
332 }
333 }else
334 error("illegal method");
335 UNPROTECT(1);
336 return(ret_);
337 }
338
339
R_merge_intersect(SEXP x_,SEXP y_,SEXP revx_,SEXP revy_,SEXP method_)340 SEXP R_merge_intersect(SEXP x_, SEXP y_, SEXP revx_, SEXP revy_, SEXP method_){
341 int *x = INTEGER(x_);
342 int *y = INTEGER(y_);
343 int nx = LENGTH(x_);
344 int ny = LENGTH(y_);
345 int n;
346 SEXP ret_;
347 PROTECT( ret_ = allocVector(INTSXP,nx) );
348 int *ret = INTEGER(ret_);
349 if(strcmp(CHAR(STRING_ELT(method_, 0)), "unique") == 0) {
350 if (asLogical(revx_)){
351 if (asLogical(revy_))
352 n = int_merge_intersect_unique_revab((ValueT *)x,nx,(ValueT *)y,ny,(ValueT *)ret);
353 else
354 n = int_merge_intersect_unique_reva((ValueT *)x,nx,(ValueT *)y,ny,(ValueT *)ret);
355 }else{
356 if (asLogical(revy_))
357 n = int_merge_intersect_unique_revb((ValueT *)x,nx,(ValueT *)y,ny,(ValueT *)ret);
358 else
359 n = int_merge_intersect_unique((ValueT *)x,nx,(ValueT *)y,ny,(ValueT *)ret);
360 }
361 }else if(strcmp(CHAR(STRING_ELT(method_, 0)), "exact") == 0) {
362 if (asLogical(revx_)){
363 if (asLogical(revy_))
364 n = int_merge_intersect_exact_revab((ValueT *)x,nx,(ValueT *)y,ny,(ValueT *)ret);
365 else
366 n = int_merge_intersect_exact_reva((ValueT *)x,nx,(ValueT *)y,ny,(ValueT *)ret);
367 }else{
368 if (asLogical(revy_))
369 n = int_merge_intersect_exact_revb((ValueT *)x,nx,(ValueT *)y,ny,(ValueT *)ret);
370 else
371 n = int_merge_intersect_exact((ValueT *)x,nx,(ValueT *)y,ny,(ValueT *)ret);
372 }
373 }else
374 error("illegal method");
375 if (n < nx){
376 SETLENGTH(ret_, n);
377 }
378 UNPROTECT(1);
379 return(ret_);
380 }
381
R_merge_symdiff(SEXP x_,SEXP y_,SEXP revx_,SEXP revy_,SEXP method_)382 SEXP R_merge_symdiff(SEXP x_, SEXP y_, SEXP revx_, SEXP revy_, SEXP method_){
383 int *x = INTEGER(x_);
384 int *y = INTEGER(y_);
385 int nx = LENGTH(x_);
386 int ny = LENGTH(y_);
387 int n;
388 SEXP ret_;
389 PROTECT( ret_ = allocVector(INTSXP,nx+ny) );
390 int *ret = INTEGER(ret_);
391 if(strcmp(CHAR(STRING_ELT(method_, 0)), "unique") == 0) {
392 if (asLogical(revx_)){
393 if (asLogical(revy_))
394 n = int_merge_symdiff_unique_revab((ValueT *)x,nx,(ValueT *)y,ny,(ValueT *)ret);
395 else
396 n = int_merge_symdiff_unique_reva((ValueT *)x,nx,(ValueT *)y,ny,(ValueT *)ret);
397 }else{
398 if (asLogical(revy_))
399 n = int_merge_symdiff_unique_revb((ValueT *)x,nx,(ValueT *)y,ny,(ValueT *)ret);
400 else
401 n = int_merge_symdiff_unique((ValueT *)x,nx,(ValueT *)y,ny,(ValueT *)ret);
402 }
403 }else if(strcmp(CHAR(STRING_ELT(method_, 0)), "exact") == 0) {
404 if (asLogical(revx_)){
405 if (asLogical(revy_))
406 n = int_merge_symdiff_exact_revab((ValueT *)x,nx,(ValueT *)y,ny,(ValueT *)ret);
407 else
408 n = int_merge_symdiff_exact_reva((ValueT *)x,nx,(ValueT *)y,ny,(ValueT *)ret);
409 }else{
410 if (asLogical(revy_))
411 n = int_merge_symdiff_exact_revb((ValueT *)x,nx,(ValueT *)y,ny,(ValueT *)ret);
412 else
413 n = int_merge_symdiff_exact((ValueT *)x,nx,(ValueT *)y,ny,(ValueT *)ret);
414 }
415 }else
416 error("illegal method");
417 if (n < (nx+ny)){
418 SETLENGTH(ret_, n);
419 }
420 UNPROTECT(1);
421 return(ret_);
422 }
423
424
R_merge_first(SEXP x_,SEXP revx_)425 SEXP R_merge_first(SEXP x_, SEXP revx_){
426 SEXP ret_;
427 PROTECT( ret_ = allocVector(INTSXP,1) );
428 if (LENGTH(x_)==0)
429 INTEGER(ret_)[0] = NA_INTEGER;
430 else if (asLogical(revx_))
431 INTEGER(ret_)[0] = -INTEGER(x_)[LENGTH(x_)-1];
432 else
433 INTEGER(ret_)[0] = INTEGER(x_)[0];
434 UNPROTECT(1);
435 return(ret_);
436 }
437
R_merge_last(SEXP x_,SEXP revx_)438 SEXP R_merge_last(SEXP x_, SEXP revx_){
439 SEXP ret_;
440 PROTECT( ret_ = allocVector(INTSXP,1) );
441 if (LENGTH(x_)==0)
442 INTEGER(ret_)[0] = NA_INTEGER;
443 else if (asLogical(revx_))
444 INTEGER(ret_)[0] = -INTEGER(x_)[0];
445 else
446 INTEGER(ret_)[0] = INTEGER(x_)[LENGTH(x_)-1];
447 UNPROTECT(1);
448 return(ret_);
449 }
450
451
452
R_merge_firstin(SEXP rangex_,SEXP y_,SEXP revx_,SEXP revy_)453 SEXP R_merge_firstin(SEXP rangex_, SEXP y_, SEXP revx_, SEXP revy_){
454 int *rx = INTEGER(rangex_);
455 int *y = INTEGER(y_);
456 int ny = LENGTH(y_);
457 SEXP ret_;
458 PROTECT( ret_ = allocVector(INTSXP,1) );
459 if (asLogical(revx_)){
460 if (asLogical(revy_)){
461 INTEGER(ret_)[0] = int_merge_firstin_revab(rx,(ValueT *)y,ny);
462 }else{
463 INTEGER(ret_)[0] = int_merge_firstin_reva(rx,(ValueT *)y,ny);
464 }
465 }else{
466 if (asLogical(revy_)){
467 INTEGER(ret_)[0] = int_merge_firstin_revb(rx,(ValueT *)y,ny);
468 }else{
469 INTEGER(ret_)[0] = int_merge_firstin(rx,(ValueT *)y,ny);
470 }
471 }
472 UNPROTECT(1);
473 return(ret_);
474 }
475
R_merge_lastin(SEXP rangex_,SEXP y_,SEXP revx_,SEXP revy_)476 SEXP R_merge_lastin(SEXP rangex_, SEXP y_, SEXP revx_, SEXP revy_){
477 int rx[2];
478 rx[0] = -INTEGER(rangex_)[1];
479 rx[1] = -INTEGER(rangex_)[0];
480 int *y = INTEGER(y_);
481 int ny = LENGTH(y_);
482 SEXP ret_;
483 PROTECT( ret_ = allocVector(INTSXP,1) );
484 if (asLogical(revx_)){
485 if (!asLogical(revy_)){
486 INTEGER(ret_)[0] = -int_merge_firstin_revab(rx,(ValueT *)y,ny);
487 }else{
488 INTEGER(ret_)[0] = -int_merge_firstin_reva(rx,(ValueT *)y,ny);
489 }
490 }else{
491 if (!asLogical(revy_)){
492 INTEGER(ret_)[0] = -int_merge_firstin_revb(rx,(ValueT *)y,ny);
493 }else{
494 INTEGER(ret_)[0] = -int_merge_firstin(rx,(ValueT *)y,ny);
495 }
496 }
497 UNPROTECT(1);
498 return(ret_);
499 }
500
501
502
R_merge_firstnotin(SEXP rangex_,SEXP y_,SEXP revx_,SEXP revy_)503 SEXP R_merge_firstnotin(SEXP rangex_, SEXP y_, SEXP revx_, SEXP revy_){
504 int *rx = INTEGER(rangex_);
505 int *y = INTEGER(y_);
506 int ny = LENGTH(y_);
507 SEXP ret_;
508 PROTECT( ret_ = allocVector(INTSXP,1) );
509 if (asLogical(revx_)){
510 if (asLogical(revy_)){
511 INTEGER(ret_)[0] = int_merge_firstnotin_revab(rx,(ValueT *)y,ny);
512 }else{
513 INTEGER(ret_)[0] = int_merge_firstnotin_reva(rx,(ValueT *)y,ny);
514 }
515 }else{
516 if (asLogical(revy_)){
517 INTEGER(ret_)[0] = int_merge_firstnotin_revb(rx,(ValueT *)y,ny);
518 }else{
519 INTEGER(ret_)[0] = int_merge_firstnotin(rx,(ValueT *)y,ny);
520 }
521 }
522 UNPROTECT(1);
523 return(ret_);
524 }
525
R_merge_lastnotin(SEXP rangex_,SEXP y_,SEXP revx_,SEXP revy_)526 SEXP R_merge_lastnotin(SEXP rangex_, SEXP y_, SEXP revx_, SEXP revy_){
527 int rx[2];
528 rx[0] = -INTEGER(rangex_)[1];
529 rx[1] = -INTEGER(rangex_)[0];
530 int *y = INTEGER(y_);
531 int ny = LENGTH(y_);
532 SEXP ret_;
533 PROTECT( ret_ = allocVector(INTSXP,1) );
534 if (asLogical(revx_)){
535 if (!asLogical(revy_)){
536 INTEGER(ret_)[0] = -int_merge_firstnotin_revab(rx,(ValueT *)y,ny);
537 }else{
538 INTEGER(ret_)[0] = -int_merge_firstnotin_reva(rx,(ValueT *)y,ny);
539 }
540 }else{
541 if (!asLogical(revy_)){
542 INTEGER(ret_)[0] = -int_merge_firstnotin_revb(rx,(ValueT *)y,ny);
543 }else{
544 INTEGER(ret_)[0] = -int_merge_firstnotin(rx,(ValueT *)y,ny);
545 }
546 }
547 UNPROTECT(1);
548 return(ret_);
549 }
550
551
R_merge_rangesect(SEXP rangex_,SEXP y_,SEXP revx_,SEXP revy_)552 SEXP R_merge_rangesect(SEXP rangex_, SEXP y_, SEXP revx_, SEXP revy_){
553 int *rx = INTEGER(rangex_);
554 int *y = INTEGER(y_);
555 int ny = LENGTH(y_);
556 int n,nx=abs(rx[1]-rx[0])+1;
557 SEXP ret_;
558 PROTECT( ret_ = allocVector(INTSXP,nx) );
559 int *ret = INTEGER(ret_);
560 if (asLogical(revx_)){
561 if (asLogical(revy_)){
562 n = int_merge_rangesect_revab(rx,(ValueT *)y,ny,(ValueT *)ret);
563 }else{
564 n = int_merge_rangesect_reva(rx,(ValueT *)y,ny,(ValueT *)ret);
565 }
566 }else{
567 if (asLogical(revy_)){
568 n = int_merge_rangesect_revb(rx,(ValueT *)y,ny,(ValueT *)ret);
569 }else{
570 n = int_merge_rangesect(rx,(ValueT *)y,ny,(ValueT *)ret);
571 }
572 }
573 if (n < nx){
574 SETLENGTH(ret_, n);
575 }
576 UNPROTECT(1);
577 return(ret_);
578 }
579
R_merge_rangediff(SEXP rangex_,SEXP y_,SEXP revx_,SEXP revy_)580 SEXP R_merge_rangediff(SEXP rangex_, SEXP y_, SEXP revx_, SEXP revy_){
581 int *rx = INTEGER(rangex_);
582 int *y = INTEGER(y_);
583 int ny = LENGTH(y_);
584 int n,nx=abs(rx[1]-rx[0])+1;
585 SEXP ret_;
586 PROTECT( ret_ = allocVector(INTSXP,nx) );
587 int *ret = INTEGER(ret_);
588 if (asLogical(revx_)){
589 if (asLogical(revy_)){
590 n = int_merge_rangediff_revab(rx,(ValueT *)y,ny,(ValueT *)ret);
591 }else{
592 n = int_merge_rangediff_reva(rx,(ValueT *)y,ny,(ValueT *)ret);
593 }
594 }else{
595 if (asLogical(revy_)){
596 n = int_merge_rangediff_revb(rx,(ValueT *)y,ny,(ValueT *)ret);
597 }else{
598 n = int_merge_rangediff(rx,(ValueT *)y,ny,(ValueT *)ret);
599 }
600 }
601 if (n < nx){
602 SETLENGTH(ret_, n);
603 }
604 UNPROTECT(1);
605 return(ret_);
606 }
607
R_merge_rangein(SEXP rangex_,SEXP y_,SEXP revx_,SEXP revy_)608 SEXP R_merge_rangein(SEXP rangex_, SEXP y_, SEXP revx_, SEXP revy_){
609 int *rx = INTEGER(rangex_);
610 int *y = INTEGER(y_);
611 int ny = LENGTH(y_);
612 int nx=abs(rx[1]-rx[0])+1;
613 SEXP ret_;
614 PROTECT( ret_ = allocVector(LGLSXP,nx) );
615 int *ret = LOGICAL(ret_);
616 if (asLogical(revx_)){
617 if (asLogical(revy_)){
618 int_merge_rangein_revab(rx,(ValueT *)y,ny,(ValueT *)ret);
619 }else{
620 int_merge_rangein_reva(rx,(ValueT *)y,ny,(ValueT *)ret);
621 }
622 }else{
623 if (asLogical(revy_)){
624 int_merge_rangein_revb(rx,(ValueT *)y,ny,(ValueT *)ret);
625 }else{
626 int_merge_rangein(rx,(ValueT *)y,ny,(ValueT *)ret);
627 }
628 }
629 UNPROTECT(1);
630 return(ret_);
631 }
632
R_merge_rangenotin(SEXP rangex_,SEXP y_,SEXP revx_,SEXP revy_)633 SEXP R_merge_rangenotin(SEXP rangex_, SEXP y_, SEXP revx_, SEXP revy_){
634 int *rx = INTEGER(rangex_);
635 int *y = INTEGER(y_);
636 int ny = LENGTH(y_);
637 int nx=abs(rx[1]-rx[0])+1;
638 SEXP ret_;
639 PROTECT( ret_ = allocVector(LGLSXP,nx) );
640 int *ret = LOGICAL(ret_);
641 if (asLogical(revx_)){
642 if (asLogical(revy_)){
643 int_merge_rangenotin_revab(rx,(ValueT *)y,ny,(ValueT *)ret);
644 }else{
645 int_merge_rangenotin_reva(rx,(ValueT *)y,ny,(ValueT *)ret);
646 }
647 }else{
648 if (asLogical(revy_)){
649 int_merge_rangenotin_revb(rx,(ValueT *)y,ny,(ValueT *)ret);
650 }else{
651 int_merge_rangenotin(rx,(ValueT *)y,ny,(ValueT *)ret);
652 }
653 }
654 UNPROTECT(1);
655 return(ret_);
656 }
657