The R Project SVN R

Rev

Rev 47040 | Go to most recent revision | Show entire file | Ignore whitespace | Details | Blame | Last modification | View Log | RSS feed

Rev 47040 Rev 47460
Line 421... Line 421...
421 
 * slow.  So now we hash.  Hashing is expensive on memory (up to 32nx
 421 
 * slow.  So now we hash.  Hashing is expensive on memory (up to 32nx
422 
 * bytes) so it is only worth doing if ns * nx is large.  If nx is
 422 
 * bytes) so it is only worth doing if ns * nx is large.  If nx is
423 
 * large, then it will be too slow unless ns is very small.
 423 
 * large, then it will be too slow unless ns is very small.
424 
 */
 424 
 */
425 
 
 425 
 
426 
#define USE_HASHING 1
 - 
 
427 
static SEXP
 426 
static SEXP
428 
stringSubscript(SEXP s, int ns, int nx, SEXP names,
 427 
stringSubscript(SEXP s, int ns, int nx, SEXP names,
429 
		StringEltGetter strg, int *stretch, Rboolean in, SEXP call)
 428 
		StringEltGetter strg, int *stretch, Rboolean in, SEXP call)
430 
{
 429 
{
431 
    SEXP indx, indexnames;
 430 
    SEXP indx, indexnames;
432 
    int i, j, nnames, sub, extra;
 431 
    int i, j, nnames, sub, extra;
433 
    int canstretch = *stretch;
 432 
    int canstretch = *stretch;
434 
#ifdef USE_HASHING
 - 
 
435 
    /* product may overflow, so check factors as well. */
 433 
    /* product may overflow, so check factors as well. */
436 
    Rboolean usehashing = in && ( ((ns > 1000 && nx) || (nx > 1000 && ns)) && (ns * nx > 15*nx + ns) );
 434 
    Rboolean usehashing = in && ( ((ns > 1000 && nx) || (nx > 1000 && ns)) && (ns * nx > 15*nx + ns) );
437 
#else
 - 
 
438 
    Rboolean usehashing = FALSE;
 - 
 
439 
#endif
 - 
 
440 
 
 435 
 
441 
    PROTECT(s);
 436 
    PROTECT(s);
442 
    PROTECT(names);
 437 
    PROTECT(names);
443 
    PROTECT(indexnames = allocVector(STRSXP, ns));
 438 
    PROTECT(indexnames = allocVector(STRSXP, ns));
444 
    nnames = nx;
 439 
    nnames = nx;
Line 449... Line 444...
449 
     * previous subscripts, since (if assigning) we may have already
 444 
     * previous subscripts, since (if assigning) we may have already
450 
     * added an element of that name. (If we are not assigning, any
 445 
     * added an element of that name. (If we are not assigning, any
451 
     * nonmatch will have given an error.)
 446 
     * nonmatch will have given an error.)
452 
     */
 447 
     */
453 
 
 448 
 
454 
#ifdef USE_HASHING
 - 
 
455 
    if(usehashing) {
 449 
    if(usehashing) {
456 
	/* must be internal, so names contains a character vector */
 450 
	/* must be internal, so names contains a character vector */
457 
	/* NB: this does not behave in the same way with respect to ""
 451 
	/* NB: this does not behave in the same way with respect to ""
458 
	   and NA names: they will match */
 452 
	   and NA names: they will match */
459 
	PROTECT(indx = match(names, s, 0));
 453 
	PROTECT(indx = match(names, s, 0));
460 
	/* second pass to correct this */
 454 
	/* second pass to correct this */
461 
	for (i = 0; i < ns; i++)
 455 
	for (i = 0; i < ns; i++)
462 
	    if(STRING_ELT(s, i) == NA_STRING || !CHAR(STRING_ELT(s, i))[0])
 456 
	    if(STRING_ELT(s, i) == NA_STRING || !CHAR(STRING_ELT(s, i))[0])
463 
		INTEGER(indx)[i] = 0;
 457 
		INTEGER(indx)[i] = 0;
- 
 
 458 
	/* FIXME: this should not be allowed, CHARSXPs only */
464 
	for (i = 0; i < ns; i++) SET_STRING_ELT(indexnames, i, R_NilValue);
 459 
	for (i = 0; i < ns; i++) SET_STRING_ELT(indexnames, i, R_NilValue);
465 
    } else {
 460 
    } else {
466 
#endif
 - 
 
467 
	PROTECT(indx = allocVector(INTSXP, ns));
 461 
	PROTECT(indx = allocVector(INTSXP, ns));
468 
	for (i = 0; i < ns; i++) {
 462 
	for (i = 0; i < ns; i++) {
469 
	    sub = 0;
 463 
	    sub = 0;
470 
	    if (names != R_NilValue) {
 464 
	    if (names != R_NilValue) {
471 
		for (j = 0; j < nnames; j++) {
 465 
		for (j = 0; j < nnames; j++) {
Line 473... Line 467...
473 
		    if (!in && TYPEOF(names_j) != CHARSXP) {
 467 
		    if (!in && TYPEOF(names_j) != CHARSXP) {
474 
			ECALL(call, _("character vector element does not have type CHARSXP"));
 468 
			ECALL(call, _("character vector element does not have type CHARSXP"));
475 
		    }
 469 
		    }
476 
		    if (NonNullStringMatch(STRING_ELT(s, i), names_j)) {
 470 
		    if (NonNullStringMatch(STRING_ELT(s, i), names_j)) {
477 
			sub = j + 1;
 471 
			sub = j + 1;
- 
 
 472 
			/* FIXME: this should not be allowed, CHARSXPs only */
478 
			SET_STRING_ELT(indexnames, i, R_NilValue);
 473 
			SET_STRING_ELT(indexnames, i, R_NilValue);
479 
			break;
 474 
			break;
480 
		    }
 475 
		    }
481 
		}
 476 
		}
482 
	    }
 477 
	    }
483 
	    INTEGER(indx)[i] = sub;
 478 
	    INTEGER(indx)[i] = sub;
484 
	}
 479 
	}
485 
#ifdef USE_HASHING
 - 
 
486 
    }
 480 
    }
487 
#endif
 481 
 
488 
 
 482 
 
489 
    for (i = 0; i < ns; i++) {
 483 
    for (i = 0; i < ns; i++) {
490 
	sub = INTEGER(indx)[i];
 484 
	sub = INTEGER(indx)[i];
491 
	if (sub == 0) {
 485 
	if (sub == 0) {
492 
	    for (j = 0 ; j < i ; j++)
 486 
	    for (j = 0 ; j < i ; j++)