The R Project SVN – R – Diff – /trunk/src/main/relop.c



#define STRCMP strcoll
#else
#define STRCMP strcmp
#endif
 
 
 
 
static SEXP string_relop(RELOP_TYPE code, SEXP s1, SEXP s2)
{
    int i, n, n1, n2;
    SEXP ans;
 

    ans = allocVector(LGLSXP, n);
 
    switch (code) {
    case EQOP:
	for (i = 0; i < n; i++) {
 
	    if ((STRING_ELT(s1, i % n1) == NA_STRING) ||
		(STRING_ELT(s2, i % n2) == NA_STRING))
		LOGICAL(ans)[i] = NA_LOGICAL;
 	    else
 
	    if (strcmp(CHAR(STRING_ELT(s1, i % n1)),
		       CHAR(STRING_ELT(s2, i % n2))) == 0)
		LOGICAL(ans)[i] = 1;
	    else
		LOGICAL(ans)[i] = 0;
	}
	break;
    case NEOP:
	for (i = 0; i < n; i++) {
 
	    if ((STRING_ELT(s1, i % n1) == NA_STRING) ||
		(STRING_ELT(s2, i % n2) == NA_STRING))
		LOGICAL(ans)[i] = NA_LOGICAL;
 	    else
 
	    if (streql(CHAR(STRING_ELT(s1, i % n1)),
		       CHAR(STRING_ELT(s2, i % n2))) != 0)
		LOGICAL(ans)[i] = 0;
	    else
		LOGICAL(ans)[i] = 1;
	}
	break;
    case LTOP:
	for (i = 0; i < n; i++) {
 
	    if ((STRING_ELT(s1, i % n1) == NA_STRING) ||
		(STRING_ELT(s2, i % n2) == NA_STRING))
		LOGICAL(ans)[i] = NA_LOGICAL;
 	    else
 
	    if (STRCMP(CHAR(STRING_ELT(s1, i % n1)),
		       CHAR(STRING_ELT(s2, i % n2))) < 0)
		LOGICAL(ans)[i] = 1;
	    else
		LOGICAL(ans)[i] = 0;
	}
	break;
    case GTOP:
	for (i = 0; i < n; i++) {
 
	    if ((STRING_ELT(s1, i % n1) == NA_STRING) ||
		(STRING_ELT(s2, i % n2) == NA_STRING))
		LOGICAL(ans)[i] = NA_LOGICAL;
 	    else
 
	    if (STRCMP(CHAR(STRING_ELT(s1, i % n1)),
		       CHAR(STRING_ELT(s2, i % n2))) > 0)
		LOGICAL(ans)[i] = 1;
	    else
		LOGICAL(ans)[i] = 0;
	}
	break;
    case LEOP:
	for (i = 0; i < n; i++) {
 
	    if ((STRING_ELT(s1, i % n1) == NA_STRING) ||
		(STRING_ELT(s2, i % n2) == NA_STRING))
		LOGICAL(ans)[i] = NA_LOGICAL;
 	    else
 
	    if (STRCMP(CHAR(STRING_ELT(s1, i % n1)),
		       CHAR(STRING_ELT(s2, i % n2))) <= 0)
		LOGICAL(ans)[i] = 1;
	    else
		LOGICAL(ans)[i] = 0;
	}
	break;
    case GEOP:
	for (i = 0; i < n; i++) {
 
	    if ((STRING_ELT(s1, i % n1) == NA_STRING) ||
		(STRING_ELT(s2, i % n2) == NA_STRING))
		LOGICAL(ans)[i] = NA_LOGICAL;
 	    else
 
	    if (STRCMP(CHAR(STRING_ELT(s1, i % n1)),
		       CHAR(STRING_ELT(s2, i % n2))) >= 0)
		LOGICAL(ans)[i] = 1;
	    else
		LOGICAL(ans)[i] = 0;

Rev 24540	Rev 24736
Line 409...	Line 409...
409	`#define STRCMP strcoll`	409	`#define STRCMP strcoll`
410	`#else`	410	`#else`
411	`#define STRCMP strcmp`	411	`#define STRCMP strcmp`
412	`#endif`	412	`#endif`
413		413
414	`/* define NASTRING to have NA_STRING treated as missing */`	-
415	`#define NASTRING`	-
416		-
417	`static SEXP string_relop(RELOP_TYPE code, SEXP s1, SEXP s2)`	414	`static SEXP string_relop(RELOP_TYPE code, SEXP s1, SEXP s2)`
418	`{`	415	`{`
419	`int i, n, n1, n2;`	416	`int i, n, n1, n2;`
420	`SEXP ans;`	417	`SEXP ans;`
421		418
Line 427...	Line 424...
427	`ans = allocVector(LGLSXP, n);`	424	`ans = allocVector(LGLSXP, n);`
428		425
429	`switch (code) {`	426	`switch (code) {`
430	`case EQOP:`	427	`case EQOP:`
431	`for (i = 0; i < n; i++) {`	428	`for (i = 0; i < n; i++) {`
432	`#ifdef NASTRING`	-
433	`if ((STRING_ELT(s1, i % n1) == NA_STRING) \|\|`	429	`if ((STRING_ELT(s1, i % n1) == NA_STRING) \|\|`
434	`(STRING_ELT(s2, i % n2) == NA_STRING))`	430	`(STRING_ELT(s2, i % n2) == NA_STRING))`
435	`LOGICAL(ans)[i] = NA_LOGICAL;`	431	`LOGICAL(ans)[i] = NA_LOGICAL;`
436	`else`	432	`else`
437	`#endif`	-
438	`if (strcmp(CHAR(STRING_ELT(s1, i % n1)),`	433	`if (strcmp(CHAR(STRING_ELT(s1, i % n1)),`
439	`CHAR(STRING_ELT(s2, i % n2))) == 0)`	434	`CHAR(STRING_ELT(s2, i % n2))) == 0)`
440	`LOGICAL(ans)[i] = 1;`	435	`LOGICAL(ans)[i] = 1;`
441	`else`	436	`else`
442	`LOGICAL(ans)[i] = 0;`	437	`LOGICAL(ans)[i] = 0;`
443	`}`	438	`}`
444	`break;`	439	`break;`
445	`case NEOP:`	440	`case NEOP:`
446	`for (i = 0; i < n; i++) {`	441	`for (i = 0; i < n; i++) {`
447	`#ifdef NASTRING`	-
448	`if ((STRING_ELT(s1, i % n1) == NA_STRING) \|\|`	442	`if ((STRING_ELT(s1, i % n1) == NA_STRING) \|\|`
449	`(STRING_ELT(s2, i % n2) == NA_STRING))`	443	`(STRING_ELT(s2, i % n2) == NA_STRING))`
450	`LOGICAL(ans)[i] = NA_LOGICAL;`	444	`LOGICAL(ans)[i] = NA_LOGICAL;`
451	`else`	445	`else`
452	`#endif`	-
453	`if (streql(CHAR(STRING_ELT(s1, i % n1)),`	446	`if (streql(CHAR(STRING_ELT(s1, i % n1)),`
454	`CHAR(STRING_ELT(s2, i % n2))) != 0)`	447	`CHAR(STRING_ELT(s2, i % n2))) != 0)`
455	`LOGICAL(ans)[i] = 0;`	448	`LOGICAL(ans)[i] = 0;`
456	`else`	449	`else`
457	`LOGICAL(ans)[i] = 1;`	450	`LOGICAL(ans)[i] = 1;`
458	`}`	451	`}`
459	`break;`	452	`break;`
460	`case LTOP:`	453	`case LTOP:`
461	`for (i = 0; i < n; i++) {`	454	`for (i = 0; i < n; i++) {`
462	`#ifdef NASTRING`	-
463	`if ((STRING_ELT(s1, i % n1) == NA_STRING) \|\|`	455	`if ((STRING_ELT(s1, i % n1) == NA_STRING) \|\|`
464	`(STRING_ELT(s2, i % n2) == NA_STRING))`	456	`(STRING_ELT(s2, i % n2) == NA_STRING))`
465	`LOGICAL(ans)[i] = NA_LOGICAL;`	457	`LOGICAL(ans)[i] = NA_LOGICAL;`
466	`else`	458	`else`
467	`#endif`	-
468	`if (STRCMP(CHAR(STRING_ELT(s1, i % n1)),`	459	`if (STRCMP(CHAR(STRING_ELT(s1, i % n1)),`
469	`CHAR(STRING_ELT(s2, i % n2))) < 0)`	460	`CHAR(STRING_ELT(s2, i % n2))) < 0)`
470	`LOGICAL(ans)[i] = 1;`	461	`LOGICAL(ans)[i] = 1;`
471	`else`	462	`else`
472	`LOGICAL(ans)[i] = 0;`	463	`LOGICAL(ans)[i] = 0;`
473	`}`	464	`}`
474	`break;`	465	`break;`
475	`case GTOP:`	466	`case GTOP:`
476	`for (i = 0; i < n; i++) {`	467	`for (i = 0; i < n; i++) {`
477	`#ifdef NASTRING`	-
478	`if ((STRING_ELT(s1, i % n1) == NA_STRING) \|\|`	468	`if ((STRING_ELT(s1, i % n1) == NA_STRING) \|\|`
479	`(STRING_ELT(s2, i % n2) == NA_STRING))`	469	`(STRING_ELT(s2, i % n2) == NA_STRING))`
480	`LOGICAL(ans)[i] = NA_LOGICAL;`	470	`LOGICAL(ans)[i] = NA_LOGICAL;`
481	`else`	471	`else`
482	`#endif`	-
483	`if (STRCMP(CHAR(STRING_ELT(s1, i % n1)),`	472	`if (STRCMP(CHAR(STRING_ELT(s1, i % n1)),`
484	`CHAR(STRING_ELT(s2, i % n2))) > 0)`	473	`CHAR(STRING_ELT(s2, i % n2))) > 0)`
485	`LOGICAL(ans)[i] = 1;`	474	`LOGICAL(ans)[i] = 1;`
486	`else`	475	`else`
487	`LOGICAL(ans)[i] = 0;`	476	`LOGICAL(ans)[i] = 0;`
488	`}`	477	`}`
489	`break;`	478	`break;`
490	`case LEOP:`	479	`case LEOP:`
491	`for (i = 0; i < n; i++) {`	480	`for (i = 0; i < n; i++) {`
492	`#ifdef NASTRING`	-
493	`if ((STRING_ELT(s1, i % n1) == NA_STRING) \|\|`	481	`if ((STRING_ELT(s1, i % n1) == NA_STRING) \|\|`
494	`(STRING_ELT(s2, i % n2) == NA_STRING))`	482	`(STRING_ELT(s2, i % n2) == NA_STRING))`
495	`LOGICAL(ans)[i] = NA_LOGICAL;`	483	`LOGICAL(ans)[i] = NA_LOGICAL;`
496	`else`	484	`else`
497	`#endif`	-
498	`if (STRCMP(CHAR(STRING_ELT(s1, i % n1)),`	485	`if (STRCMP(CHAR(STRING_ELT(s1, i % n1)),`
499	`CHAR(STRING_ELT(s2, i % n2))) <= 0)`	486	`CHAR(STRING_ELT(s2, i % n2))) <= 0)`
500	`LOGICAL(ans)[i] = 1;`	487	`LOGICAL(ans)[i] = 1;`
501	`else`	488	`else`
502	`LOGICAL(ans)[i] = 0;`	489	`LOGICAL(ans)[i] = 0;`
503	`}`	490	`}`
504	`break;`	491	`break;`
505	`case GEOP:`	492	`case GEOP:`
506	`for (i = 0; i < n; i++) {`	493	`for (i = 0; i < n; i++) {`
507	`#ifdef NASTRING`	-
508	`if ((STRING_ELT(s1, i % n1) == NA_STRING) \|\|`	494	`if ((STRING_ELT(s1, i % n1) == NA_STRING) \|\|`
509	`(STRING_ELT(s2, i % n2) == NA_STRING))`	495	`(STRING_ELT(s2, i % n2) == NA_STRING))`
510	`LOGICAL(ans)[i] = NA_LOGICAL;`	496	`LOGICAL(ans)[i] = NA_LOGICAL;`
511	`else`	497	`else`
512	`#endif`	-
513	`if (STRCMP(CHAR(STRING_ELT(s1, i % n1)),`	498	`if (STRCMP(CHAR(STRING_ELT(s1, i % n1)),`
514	`CHAR(STRING_ELT(s2, i % n2))) >= 0)`	499	`CHAR(STRING_ELT(s2, i % n2))) >= 0)`
515	`LOGICAL(ans)[i] = 1;`	500	`LOGICAL(ans)[i] = 1;`
516	`else`	501	`else`
517	`LOGICAL(ans)[i] = 0;`	502	`LOGICAL(ans)[i] = 0;`

The R Project SVN R

(root)/trunk/src/main/relop.c – Rev 24540 → 24736