fcase support scalar condition, vectorize default and lazy-eval default #4264
There are no files selected for viewing
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
|
|
@@ -201,105 +201,106 @@ SEXP fifelseR(SEXP l, SEXP a, SEXP b, SEXP na) { | |
| return ans; | ||
| } | ||
|
|
||
| SEXP fcaseR(SEXP rho, SEXP args) { | ||
| const int narg=length(args); // `default` will take the last two positions | ||
| if (narg % 2) { | ||
| error(_("Received %d inputs; please supply an even number of arguments in ..., " | ||
| "consisting of logical condition, resulting value pairs (in that order). " | ||
| "Note that the default argument must be named explicitly, e.g., default=0"), narg - 2); | ||
| } | ||
| int nprotect=0, l; | ||
| int64_t len0=0, len1=0, len2=0; | ||
| SEXP ans=R_NilValue, value0=R_NilValue, tracker=R_NilValue, whens=R_NilValue, thens=R_NilValue; | ||
| PROTECT_INDEX Iwhens, Ithens; | ||
| PROTECT_WITH_INDEX(whens, &Iwhens); nprotect++; | ||
| PROTECT_WITH_INDEX(thens, &Ithens); nprotect++; | ||
| SEXPTYPE type0=NILSXP; | ||
| // naout means if the output is scalar logic na | ||
| bool imask = true, naout = false, idefault = false; | ||
| int *restrict p = NULL; | ||
| const int n = narg/2; | ||
| for (int i=0; i<n; ++i) { | ||
| idefault = i == (n - 1); // mark if the current eval is the `default` on R side | ||
| REPROTECT(whens = eval(SEXPPTR_RO(args)[2*i], rho), Iwhens); | ||
| REPROTECT(thens = eval(SEXPPTR_RO(args)[2*i+1], rho), Ithens); | ||
| if (isS4(thens) && !INHERITS(thens, char_nanotime)) { | ||
|
Member
There was a problem hiding this comment. Is PROTECTion required in this branch (before erroring)?
Member
There was a problem hiding this comment. We don't need to right? That's my read of WRE/what I'm used to elsewhere (also on Garbage Collection):
|
||
| error(_("S4 class objects (except nanotime) are not supported. Please see https://github.com/Rdatatable/data.table/issues/4131.")); | ||
| } | ||
| if (!isLogical(whens)) { | ||
|
TysonStanley marked this conversation as resolved.
|
||
| error(_("Argument #%d must be logical but was of type %s."), 2*i+1, type2char(TYPEOF(whens))); | ||
| } | ||
| const int *restrict pwhens = LOGICAL(whens); | ||
| l = 0; | ||
| if (i == 0) { | ||
| len0 = xlength(whens); | ||
| len2 = len0; | ||
| type0 = TYPEOF(thens); | ||
| value0 = thens; | ||
| ans = PROTECT(allocVector(type0, len0)); nprotect++; | ||
| copyMostAttrib(thens, ans); | ||
| tracker = PROTECT(allocVector(INTSXP, len0)); nprotect++; | ||
| p = INTEGER(tracker); | ||
| } else { | ||
| imask = false; | ||
| naout = xlength(thens) == 1 && TYPEOF(thens) == LGLSXP && LOGICAL(thens)[0]==NA_LOGICAL; | ||
| if (xlength(whens) != len0 && xlength(whens) != 1) { | ||
| // no need to check `idefault` here because the con for default is always `TRUE` | ||
| error(_("Argument #%d has length %lld which differs from that of argument #1 (%lld). " | ||
| "Please make sure all logical conditions have the same length or length 1."), | ||
| i*2+1, (long long)xlength(whens), (long long)len0); | ||
| } | ||
| if (!naout && TYPEOF(thens) != type0) { | ||
| if (idefault) { | ||
| error(_("Resulting value is of type %s but 'default' is of type %s. " | ||
| "Please make sure that both arguments have the same type."), type2char(type0), type2char(TYPEOF(thens))); | ||
| } else { | ||
| error(_("Argument #%d is of type %s, however argument #2 is of type %s. " | ||
| "Please make sure all output values have the same type."), | ||
| i*2+2, type2char(TYPEOF(thens)), type2char(type0)); | ||
| } | ||
| } | ||
| if (!naout) { | ||
| if (!R_compute_identical(PROTECT(getAttrib(value0, R_ClassSymbol)), PROTECT(getAttrib(thens, R_ClassSymbol)), 0)) { | ||
| if (idefault) { | ||
| error(_("Resulting value has different class than 'default'. " | ||
| "Please make sure that both arguments have the same class.")); | ||
| } else { | ||
| error(_("Argument #%d has different class than argument #2, " | ||
| "Please make sure all output values have the same class."), i*2+2); | ||
| } | ||
| } | ||
| UNPROTECT(2); // class(value0), class(thens) | ||
| } | ||
| if (!naout && isFactor(value0)) { | ||
| if (!R_compute_identical(PROTECT(getAttrib(value0, R_LevelsSymbol)), PROTECT(getAttrib(thens, R_LevelsSymbol)), 0)) { | ||
| if (idefault) { | ||
| error(_("Resulting value and 'default' are both type factor but their levels are different.")); | ||
| } else { | ||
| error(_("Argument #2 and argument #%d are both factor but their levels are different."), i*2+2); | ||
| } | ||
| } | ||
| UNPROTECT(2); // levels(value0), levels(thens) | ||
| } | ||
| } | ||
| len1 = xlength(thens); | ||
| if (len1 != len0 && len1 != 1) { | ||
| if (idefault) { | ||
| error(_("Length of 'default' must be 1 or %lld."), (long long)len0); | ||
| } else { | ||
| error(_("Length of output value #%d (%lld) must either be 1 or match the length of the logical condition (%lld)."), i*2+2, (long long)len1, (long long)len0); | ||
| } | ||
| } | ||
| int64_t thenMask = len1>1 ? INT64_MAX : 0, whenMask = xlength(whens)>1 ? INT64_MAX : 0; | ||
| switch(TYPEOF(ans)) { | ||
| case LGLSXP: { | ||
| const int *restrict pthens; | ||
| if (!naout) pthens = LOGICAL(thens); // the content is not useful if out is NA_LOGICAL scalar | ||
|
Member
There was a problem hiding this comment. (Applies to other cases too): Should the
Member
There was a problem hiding this comment. I had a similar thought about reorganizing the code... but probably better to explore as a follow-up. |
||
| int *restrict pans = LOGICAL(ans); | ||
| const int pna = NA_LOGICAL; | ||
| for (int64_t j=0; j<len2; ++j) { | ||
| const int64_t idx = imask ? j : p[j]; | ||
| if (pwhens[idx & whenMask]==1) { | ||
| pans[idx] = naout ? pna : pthens[idx & thenMask]; | ||
| } else { | ||
| if (imask) { | ||
| pans[j] = pna; | ||
|
|
@@ -309,13 +310,14 @@ SEXP fcaseR(SEXP na, SEXP rho, SEXP args) { | |
| } | ||
| } break; | ||
| case INTSXP: { | ||
| const int *restrict pthens; | ||
| if (!naout) pthens = INTEGER(thens); // the content is not useful if out is NA_LOGICAL scalar | ||
| int *restrict pans = INTEGER(ans); | ||
| const int pna = NA_INTEGER; | ||
| for (int64_t j=0; j<len2; ++j) { | ||
| const int64_t idx = imask ? j : p[j]; | ||
| if (pwhens[idx & whenMask]==1) { | ||
| pans[idx] = naout ? pna : pthens[idx & thenMask]; | ||
| } else { | ||
| if (imask) { | ||
| pans[j] = pna; | ||
|
|
@@ -325,14 +327,15 @@ SEXP fcaseR(SEXP na, SEXP rho, SEXP args) { | |
| } | ||
| } break; | ||
| case REALSXP: { | ||
| const double *restrict pthens; | ||
| if (!naout) pthens = REAL(thens); // the content is not useful if out is NA_LOGICAL scalar | ||
| double *restrict pans = REAL(ans); | ||
| const double na_double = INHERITS(ans, char_integer64) ? NA_INT64_D : NA_REAL; | ||
| const double pna = na_double; | ||
| for (int64_t j=0; j<len2; ++j) { | ||
| const int64_t idx = imask ? j : p[j]; | ||
| if (pwhens[idx & whenMask]==1) { | ||
| pans[idx] = naout ? pna : pthens[idx & thenMask]; | ||
| } else { | ||
| if (imask) { | ||
| pans[j] = pna; | ||
|
|
@@ -342,13 +345,14 @@ SEXP fcaseR(SEXP na, SEXP rho, SEXP args) { | |
| } | ||
| } break; | ||
| case CPLXSXP: { | ||
| const Rcomplex *restrict pthens; | ||
| if (!naout) pthens = COMPLEX(thens); // the content is not useful if out is NA_LOGICAL scalar | ||
| Rcomplex *restrict pans = COMPLEX(ans); | ||
| const Rcomplex pna = NA_CPLX; | ||
| for (int64_t j=0; j<len2; ++j) { | ||
| const int64_t idx = imask ? j : p[j]; | ||
| if (pwhens[idx & whenMask]==1) { | ||
| pans[idx] = naout ? pna : pthens[idx & thenMask]; | ||
| } else { | ||
| if (imask) { | ||
| pans[j] = pna; | ||
|
|
@@ -358,44 +362,43 @@ SEXP fcaseR(SEXP na, SEXP rho, SEXP args) { | |
| } | ||
| } break; | ||
| case STRSXP: { | ||
| const SEXP *restrict pthens; | ||
|
Member
There was a problem hiding this comment. Is
Member
There was a problem hiding this comment. I also think it's fine, but OTOH, I can't tell whether |
||
| if (!naout) pthens = STRING_PTR_RO(thens); // the content is not useful if out is NA_LOGICAL scalar | ||
| const SEXP pna = NA_STRING; | ||
| for (int64_t j=0; j<len2; ++j) { | ||
| const int64_t idx = imask ? j : p[j]; | ||
| if (pwhens[idx & whenMask]==1) { | ||
| SET_STRING_ELT(ans, idx, naout ? pna : pthens[idx & thenMask]); | ||
| } else { | ||
| if (imask) { | ||
| SET_STRING_ELT(ans, j, pna); | ||
| } | ||
| p[l++] = idx; | ||
| } | ||
| } | ||
| } break; | ||
| case VECSXP: { | ||
| // the default value of VECSXP is `NULL` so we don't need to explicitly | ||
| // assign the NA values as it does for other atomic types | ||
| const SEXP *restrict pthens; | ||
| if (!naout) pthens = SEXPPTR_RO(thens); // the content is not useful if out is NA_LOGICAL scalar | ||
| for (int64_t j=0; j<len2; ++j) { | ||
| const int64_t idx = imask ? j : p[j]; | ||
| if (pwhens[idx & whenMask]==1) { | ||
| if (!naout) SET_VECTOR_ELT(ans, idx, pthens[idx & thenMask]); | ||
| } else { | ||
| p[l++] = idx; | ||
| } | ||
| } | ||
| } break; | ||
| default: | ||
| error(_("Type '%s' is not supported."), type2char(TYPEOF(ans))); | ||
|
Member
There was a problem hiding this comment. I think we should mention what argument the "Type" is referring to.
Member
There was a problem hiding this comment. One thing here is getting a consistent argument to make translation easier: So I would move this to a follow-up where we try and improve that message more generally, maybe as "Type '%s' is not supported in argument %s". |
||
| } | ||
| if (l==0) { | ||
| break; // stop early as nothing left to do | ||
| } | ||
| len2 = l; | ||
| } | ||
| UNPROTECT(nprotect); // whens, thens, ans, tracker | ||
| return ans; | ||
| } | ||
Add this suggestion to a batch that can be applied as a single commit.
This suggestion is invalid because no changes were made to the code.
Suggestions cannot be applied while the pull request is closed.
Suggestions cannot be applied while viewing a subset of changes.
Only one suggestion per line can be applied in a batch.
Add this suggestion to a batch that can be applied as a single commit.
Applying suggestions on deleted lines is not supported.
You must change the existing code in this line in order to create a valid suggestion.
Outdated suggestions cannot be applied.
This suggestion has been applied or marked resolved.
Suggestions cannot be applied from pending reviews.
Suggestions cannot be applied on multi-line comments.
Suggestions cannot be applied while the pull request is queued to merge.
Suggestion cannot be applied right now. Please check back later.
There was a problem hiding this comment.
Choose a reason for hiding this comment
The reason will be displayed to describe this comment to others. Learn more.
I don't understand why
PROTECT_WITH_INDEXis being used. Could a comment be added explaining what these variables are and why this protection method was chosen?There was a problem hiding this comment.
Choose a reason for hiding this comment
The reason will be displayed to describe this comment to others. Learn more.
The basic idea is to re-use memory as we go along, I tried naming these
when/thento evokeCASE WHEN A THEN B WHEN C THEN D .... SoPROTECT_INDEXis to make the memory forA,C,E, ... is in the same place, same forB,D,F, ...(AIUI)
I am not sure the benefits/tradeoffs here. The first commit in this branch was much simpler 3334d0c
There was a problem hiding this comment.
Choose a reason for hiding this comment
The reason will be displayed to describe this comment to others. Learn more.
I am still noob at
PROTECT_WITH_INDEX()so I turned to LLM for some explanations...https://g.co/gemini/share/85cdc98bb748
https://chatgpt.com/share/a4792977-f24a-47da-95c0-da48a1ad7c4c
Claude (permalinks not supported?)
The main themes are pretty consistent -- the alternative involves doing
UNPROTECT(2)and thenPROTECT()twice again in each iteration, hence potentially lots of RAM churn that we avoid withPROTECT_WITH_INDEX().