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



    SEXP pat, vec, ind, ans;
    SEXP opt_costs, opt_bounds;
    int opt_icase, opt_value, opt_fixed, useBytes;
    R_xlen_t i, j, n;
    int nmatches, patlen;
    bool useWC = false;
    const void *vmax = NULL;
 
    regex_t reg;
    regaparams_t params;
    regamatch_t match;

 
    if(opt_icase) cflags |= REG_ICASE;
 
    n = XLENGTH(vec);
    if(!useBytes) {
	bool haveBytes = IS_BYTES(STRING_ELT(pat, 0));
	if(!haveBytes)
	    for (i = 0; i < n; i++)
		if(IS_BYTES(STRING_ELT(vec, i))) {
		    haveBytes = true;
		    break;
		}
	if(haveBytes) useBytes = true;
    }
    if(!useBytes) {
	useWC = !IS_ASCII(STRING_ELT(pat, 0));
	if(!useWC) {
	    for (i = 0 ; i < n ; i++) {
		if(STRING_ELT(vec, i) == NA_STRING) continue;
		if(!IS_ASCII(STRING_ELT(vec, i))) {
		    useWC = true;
		    break;
		}
	    }
	}
    }

#define COUNTS(I, J, K)		INTEGER(counts)[I + J * nx + K * nxy]
 
#define MAT(X, I, J)		X[I + (J) * nr]
 
static SEXP
adist_full(SEXP x, SEXP y, double *costs, bool opt_counts)
{
    SEXP ans, counts, trafos = R_NilValue /* -Wall */, dimnames, names;
    double cost_ins, cost_del, cost_sub;
    double *dists, d, d_ins, d_del, d_sub;
    char *paths = NULL, p, *buf = NULL;

attribute_hidden SEXP do_adist(SEXP call, SEXP op, SEXP args, SEXP env)
{
    SEXP x, y;
    SEXP ans, counts, offsets, dimnames, names, elt;
    SEXP opt_costs;
    bool opt_fixed, opt_partial, opt_counts, opt_icase, useBytes;
    int i = 0, j = 0, m, nx, ny, nxy;
    const char *s, *t;
    const void *vmax = NULL;
 
    bool haveBytes, useWC = false;
 
    regex_t reg;
    regaparams_t params;
    regamatch_t match;
    size_t nmatch = 0 /* -Wall */;

 
    checkArity(op, args);
    x = CAR(args); args = CDR(args);
    y = CAR(args); args = CDR(args);
    opt_costs = CAR(args); args = CDR(args);
    opt_counts = asBool2(CAR(args), call); args = CDR(args);
    opt_fixed = asBool2(CAR(args), call); args = CDR(args);
    opt_partial = asBool2(CAR(args), call); args = CDR(args);
    opt_icase = asBool2(CAR(args), call); args = CDR(args);
    useBytes = asBool2(CAR(args), call);
 
    if(opt_counts == NA_INTEGER) opt_counts = 0;
    if(opt_fixed == NA_INTEGER) opt_fixed = 1;
    if(opt_partial == NA_INTEGER) opt_partial = 0;
    if(opt_icase == NA_INTEGER) opt_icase = 0;

    nx = length(x);
    ny = length(y);
    nxy = nx * ny;
 
    if(!useBytes) {
	haveBytes = false;
	for(i = 0; i < nx; i++) {
	    if(IS_BYTES(STRING_ELT(x, i))) {
		haveBytes = true;
		break;
	    }
	}
	if(!haveBytes) {
	    for(j = 0; j < ny; j++) {
		if(IS_BYTES(STRING_ELT(y, j))) {
		    haveBytes = true;
		    break;
		}
	    }
	}
	if(haveBytes) useBytes = true;
    }
 
    if(!useBytes) {
	for(i = 0; i < nx; i++) {
	    if(STRING_ELT(x, i) == NA_STRING) continue;
	    if(!IS_ASCII(STRING_ELT(x, i))) {
		useWC = true;
		break;
	    }
	}
	if(!useWC) {
	    for(j = 0; j < ny; j++) {
		if(STRING_ELT(y, j) == NA_STRING) continue;
		if(!IS_ASCII(STRING_ELT(y, j))) {
		    useWC = true;
		    break;
		}
	    }
	}
    }

{
    SEXP pat, vec, ans, matchpos, matchlen;
    SEXP opt_bounds, opt_costs;
    int opt_icase, opt_fixed, useBytes;
 
    bool haveBytes, useWC = false;
    const char *s, *t;
    const void *vmax = NULL;
 
    regex_t reg;
    size_t nmatch;

    if(!useBytes) {
	haveBytes = IS_BYTES(STRING_ELT(pat, 0));
	if(!haveBytes)
	    for(R_xlen_t i = 0; i < n; i++) {
		if(IS_BYTES(STRING_ELT(vec, i))) {
		    haveBytes = true;
		    break;
		}
	    }
	if(haveBytes) useBytes = true;
    }
 
    if(!useBytes) {
	useWC = !IS_ASCII(STRING_ELT(pat, 0));
	if(!useWC) {
	    for(R_xlen_t i = 0 ; i < n ; i++) {
		if(STRING_ELT(vec, i) == NA_STRING) continue;
		if(!IS_ASCII(STRING_ELT(vec, i))) {
		    useWC = true;
		    break;
		}
	    }
	}
    }

		    INTEGER(matchlen)[j] = match.pmatch[j].rm_eo - so;
		}
		setAttrib(matchpos, install("match.length"), matchlen);
		if(useBytes)
		    setAttrib(matchpos, install("useBytes"),
			      ScalarLogical(true));
		SET_VECTOR_ELT(ans, i, matchpos);
		UNPROTECT(2);
	    } else {
		/* No match (or could there be an error?). */
		/* Alternatively, could return nmatch -1 values.

Rev 87808	Rev 87848
Line 100...	Line 100...
100	`SEXP pat, vec, ind, ans;`	100	`SEXP pat, vec, ind, ans;`
101	`SEXP opt_costs, opt_bounds;`	101	`SEXP opt_costs, opt_bounds;`
102	`int opt_icase, opt_value, opt_fixed, useBytes;`	102	`int opt_icase, opt_value, opt_fixed, useBytes;`
103	`R_xlen_t i, j, n;`	103	`R_xlen_t i, j, n;`
104	`int nmatches, patlen;`	104	`int nmatches, patlen;`
105	`Rboolean useWC = FALSE;`	105	`bool useWC = false;`
106	`const void *vmax = NULL;`	106	`const void *vmax = NULL;`
107		107
108	`regex_t reg;`	108	`regex_t reg;`
109	`regaparams_t params;`	109	`regaparams_t params;`
110	`regamatch_t match;`	110	`regamatch_t match;`
Line 137...	Line 137...
137		137
138	`if(opt_icase) cflags \|= REG_ICASE;`	138	`if(opt_icase) cflags \|= REG_ICASE;`
139		139
140	`n = XLENGTH(vec);`	140	`n = XLENGTH(vec);`
141	`if(!useBytes) {`	141	`if(!useBytes) {`
142	`Rboolean haveBytes = IS_BYTES(STRING_ELT(pat, 0));`	142	`bool haveBytes = IS_BYTES(STRING_ELT(pat, 0));`
143	`if(!haveBytes)`	143	`if(!haveBytes)`
144	`for (i = 0; i < n; i++)`	144	`for (i = 0; i < n; i++)`
145	`if(IS_BYTES(STRING_ELT(vec, i))) {`	145	`if(IS_BYTES(STRING_ELT(vec, i))) {`
146	`haveBytes = TRUE;`	146	`haveBytes = true;`
147	`break;`	147	`break;`
148	`}`	148	`}`
149	`if(haveBytes) useBytes = TRUE;`	149	`if(haveBytes) useBytes = true;`
150	`}`	150	`}`
151	`if(!useBytes) {`	151	`if(!useBytes) {`
152	`useWC = !IS_ASCII(STRING_ELT(pat, 0));`	152	`useWC = !IS_ASCII(STRING_ELT(pat, 0));`
153	`if(!useWC) {`	153	`if(!useWC) {`
154	`for (i = 0 ; i < n ; i++) {`	154	`for (i = 0 ; i < n ; i++) {`
155	`if(STRING_ELT(vec, i) == NA_STRING) continue;`	155	`if(STRING_ELT(vec, i) == NA_STRING) continue;`
156	`if(!IS_ASCII(STRING_ELT(vec, i))) {`	156	`if(!IS_ASCII(STRING_ELT(vec, i))) {`
157	`useWC = TRUE;`	157	`useWC = true;`
158	`break;`	158	`break;`
159	`}`	159	`}`
160	`}`	160	`}`
161	`}`	161	`}`
162	`}`	162	`}`
Line 293...	Line 293...
293	`#define COUNTS(I, J, K) INTEGER(counts)[I + J * nx + K * nxy]`	293	`#define COUNTS(I, J, K) INTEGER(counts)[I + J * nx + K * nxy]`
294		294
295	`#define MAT(X, I, J) X[I + (J) * nr]`	295	`#define MAT(X, I, J) X[I + (J) * nr]`
296		296
297	`static SEXP`	297	`static SEXP`
298	`adist_full(SEXP x, SEXP y, double *costs, Rboolean opt_counts)`	298	`adist_full(SEXP x, SEXP y, double *costs, bool opt_counts)`
299	`{`	299	`{`
300	`SEXP ans, counts, trafos = R_NilValue /* -Wall */, dimnames, names;`	300	`SEXP ans, counts, trafos = R_NilValue /* -Wall */, dimnames, names;`
301	`double cost_ins, cost_del, cost_sub;`	301	`double cost_ins, cost_del, cost_sub;`
302	`double *dists, d, d_ins, d_del, d_sub;`	302	`double *dists, d, d_ins, d_del, d_sub;`
303	`char paths = NULL, p, buf = NULL;`	303	`char paths = NULL, p, buf = NULL;`
Line 488...	Line 488...
488	`attribute_hidden SEXP do_adist(SEXP call, SEXP op, SEXP args, SEXP env)`	488	`attribute_hidden SEXP do_adist(SEXP call, SEXP op, SEXP args, SEXP env)`
489	`{`	489	`{`
490	`SEXP x, y;`	490	`SEXP x, y;`
491	`SEXP ans, counts, offsets, dimnames, names, elt;`	491	`SEXP ans, counts, offsets, dimnames, names, elt;`
492	`SEXP opt_costs;`	492	`SEXP opt_costs;`
493	`Rboolean opt_fixed, opt_partial, opt_counts, opt_icase, useBytes;`	493	`bool opt_fixed, opt_partial, opt_counts, opt_icase, useBytes;`
494	`int i = 0, j = 0, m, nx, ny, nxy;`	494	`int i = 0, j = 0, m, nx, ny, nxy;`
495	`const char s, t;`	495	`const char s, t;`
496	`const void *vmax = NULL;`	496	`const void *vmax = NULL;`
497		497
498	`Rboolean haveBytes, useWC = FALSE;`	498	`bool haveBytes, useWC = false;`
499		499
500	`regex_t reg;`	500	`regex_t reg;`
501	`regaparams_t params;`	501	`regaparams_t params;`
502	`regamatch_t match;`	502	`regamatch_t match;`
503	`size_t nmatch = 0 /* -Wall */;`	503	`size_t nmatch = 0 /* -Wall */;`
Line 507...	Line 507...
507		507
508	`checkArity(op, args);`	508	`checkArity(op, args);`
509	`x = CAR(args); args = CDR(args);`	509	`x = CAR(args); args = CDR(args);`
510	`y = CAR(args); args = CDR(args);`	510	`y = CAR(args); args = CDR(args);`
511	`opt_costs = CAR(args); args = CDR(args);`	511	`opt_costs = CAR(args); args = CDR(args);`
512	`opt_counts = asRbool(CAR(args), call); args = CDR(args);`	512	`opt_counts = asBool2(CAR(args), call); args = CDR(args);`
513	`opt_fixed = asRbool(CAR(args), call); args = CDR(args);`	513	`opt_fixed = asBool2(CAR(args), call); args = CDR(args);`
514	`opt_partial = asRbool(CAR(args), call); args = CDR(args);`	514	`opt_partial = asBool2(CAR(args), call); args = CDR(args);`
515	`opt_icase = asRbool(CAR(args), call); args = CDR(args);`	515	`opt_icase = asBool2(CAR(args), call); args = CDR(args);`
516	`useBytes = asRbool(CAR(args), call);`	516	`useBytes = asBool2(CAR(args), call);`
517		517
518	`if(opt_counts == NA_INTEGER) opt_counts = 0;`	518	`if(opt_counts == NA_INTEGER) opt_counts = 0;`
519	`if(opt_fixed == NA_INTEGER) opt_fixed = 1;`	519	`if(opt_fixed == NA_INTEGER) opt_fixed = 1;`
520	`if(opt_partial == NA_INTEGER) opt_partial = 0;`	520	`if(opt_partial == NA_INTEGER) opt_partial = 0;`
521	`if(opt_icase == NA_INTEGER) opt_icase = 0;`	521	`if(opt_icase == NA_INTEGER) opt_icase = 0;`
Line 539...	Line 539...
539	`nx = length(x);`	539	`nx = length(x);`
540	`ny = length(y);`	540	`ny = length(y);`
541	`nxy = nx * ny;`	541	`nxy = nx * ny;`
542		542
543	`if(!useBytes) {`	543	`if(!useBytes) {`
544	`haveBytes = FALSE;`	544	`haveBytes = false;`
545	`for(i = 0; i < nx; i++) {`	545	`for(i = 0; i < nx; i++) {`
546	`if(IS_BYTES(STRING_ELT(x, i))) {`	546	`if(IS_BYTES(STRING_ELT(x, i))) {`
547	`haveBytes = TRUE;`	547	`haveBytes = true;`
548	`break;`	548	`break;`
549	`}`	549	`}`
550	`}`	550	`}`
551	`if(!haveBytes) {`	551	`if(!haveBytes) {`
552	`for(j = 0; j < ny; j++) {`	552	`for(j = 0; j < ny; j++) {`
553	`if(IS_BYTES(STRING_ELT(y, j))) {`	553	`if(IS_BYTES(STRING_ELT(y, j))) {`
554	`haveBytes = TRUE;`	554	`haveBytes = true;`
555	`break;`	555	`break;`
556	`}`	556	`}`
557	`}`	557	`}`
558	`}`	558	`}`
559	`if(haveBytes) useBytes = TRUE;`	559	`if(haveBytes) useBytes = true;`
560	`}`	560	`}`
561		561
562	`if(!useBytes) {`	562	`if(!useBytes) {`
563	`for(i = 0; i < nx; i++) {`	563	`for(i = 0; i < nx; i++) {`
564	`if(STRING_ELT(x, i) == NA_STRING) continue;`	564	`if(STRING_ELT(x, i) == NA_STRING) continue;`
565	`if(!IS_ASCII(STRING_ELT(x, i))) {`	565	`if(!IS_ASCII(STRING_ELT(x, i))) {`
566	`useWC = TRUE;`	566	`useWC = true;`
567	`break;`	567	`break;`
568	`}`	568	`}`
569	`}`	569	`}`
570	`if(!useWC) {`	570	`if(!useWC) {`
571	`for(j = 0; j < ny; j++) {`	571	`for(j = 0; j < ny; j++) {`
572	`if(STRING_ELT(y, j) == NA_STRING) continue;`	572	`if(STRING_ELT(y, j) == NA_STRING) continue;`
573	`if(!IS_ASCII(STRING_ELT(y, j))) {`	573	`if(!IS_ASCII(STRING_ELT(y, j))) {`
574	`useWC = TRUE;`	574	`useWC = true;`
575	`break;`	575	`break;`
576	`}`	576	`}`
577	`}`	577	`}`
578	`}`	578	`}`
579	`}`	579	`}`
Line 737...	Line 737...
737	`{`	737	`{`
738	`SEXP pat, vec, ans, matchpos, matchlen;`	738	`SEXP pat, vec, ans, matchpos, matchlen;`
739	`SEXP opt_bounds, opt_costs;`	739	`SEXP opt_bounds, opt_costs;`
740	`int opt_icase, opt_fixed, useBytes;`	740	`int opt_icase, opt_fixed, useBytes;`
741		741
742	`Rboolean haveBytes, useWC = FALSE;`	742	`bool haveBytes, useWC = false;`
743	`const char s, t;`	743	`const char s, t;`
744	`const void *vmax = NULL;`	744	`const void *vmax = NULL;`
745		745
746	`regex_t reg;`	746	`regex_t reg;`
747	`size_t nmatch;`	747	`size_t nmatch;`
Line 787...	Line 787...
787	`if(!useBytes) {`	787	`if(!useBytes) {`
788	`haveBytes = IS_BYTES(STRING_ELT(pat, 0));`	788	`haveBytes = IS_BYTES(STRING_ELT(pat, 0));`
789	`if(!haveBytes)`	789	`if(!haveBytes)`
790	`for(R_xlen_t i = 0; i < n; i++) {`	790	`for(R_xlen_t i = 0; i < n; i++) {`
791	`if(IS_BYTES(STRING_ELT(vec, i))) {`	791	`if(IS_BYTES(STRING_ELT(vec, i))) {`
792	`haveBytes = TRUE;`	792	`haveBytes = true;`
793	`break;`	793	`break;`
794	`}`	794	`}`
795	`}`	795	`}`
796	`if(haveBytes) useBytes = TRUE;`	796	`if(haveBytes) useBytes = true;`
797	`}`	797	`}`
798		798
799	`if(!useBytes) {`	799	`if(!useBytes) {`
800	`useWC = !IS_ASCII(STRING_ELT(pat, 0));`	800	`useWC = !IS_ASCII(STRING_ELT(pat, 0));`
801	`if(!useWC) {`	801	`if(!useWC) {`
802	`for(R_xlen_t i = 0 ; i < n ; i++) {`	802	`for(R_xlen_t i = 0 ; i < n ; i++) {`
803	`if(STRING_ELT(vec, i) == NA_STRING) continue;`	803	`if(STRING_ELT(vec, i) == NA_STRING) continue;`
804	`if(!IS_ASCII(STRING_ELT(vec, i))) {`	804	`if(!IS_ASCII(STRING_ELT(vec, i))) {`
805	`useWC = TRUE;`	805	`useWC = true;`
806	`break;`	806	`break;`
807	`}`	807	`}`
808	`}`	808	`}`
809	`}`	809	`}`
810	`}`	810	`}`
Line 889...	Line 889...
889	`INTEGER(matchlen)[j] = match.pmatch[j].rm_eo - so;`	889	`INTEGER(matchlen)[j] = match.pmatch[j].rm_eo - so;`
890	`}`	890	`}`
891	`setAttrib(matchpos, install("match.length"), matchlen);`	891	`setAttrib(matchpos, install("match.length"), matchlen);`
892	`if(useBytes)`	892	`if(useBytes)`
893	`setAttrib(matchpos, install("useBytes"),`	893	`setAttrib(matchpos, install("useBytes"),`
894	`ScalarLogical(TRUE));`	894	`ScalarLogical(true));`
895	`SET_VECTOR_ELT(ans, i, matchpos);`	895	`SET_VECTOR_ELT(ans, i, matchpos);`
896	`UNPROTECT(2);`	896	`UNPROTECT(2);`
897	`} else {`	897	`} else {`
898	`/* No match (or could there be an error?). */`	898	`/* No match (or could there be an error?). */`
899	`/* Alternatively, could return nmatch -1 values.`	899	`/* Alternatively, could return nmatch -1 values.`

The R Project SVN R

(root)/trunk/src/main/agrep.c @ 77458 – Rev 87808 → 87848