Totally drop isReallyReal, just use isRealReallyInt with flavors for 32/64

MichaelChirico · MichaelChirico · commit 8ac2ae0d380c · 2024-11-26T23:17:49.000Z
diff --git a/R/IDateTime.R b/R/IDateTime.R
@@ -99,7 +99,7 @@ round.IDate = function(x, digits=c("weeks", "months", "quarters", "years"), ...)
   # TODO: investigate Ops.IDate method a la Ops.difftime
   if (inherits(e1, "difftime") || inherits(e2, "difftime"))
     internal_error("difftime objects may not be added to IDate, but Ops dispatch should have intervened to prevent this") # nocov
-  if (isReallyReal(e1) || isReallyReal(e2)) {
+  if (isRealReallyInt32(e1) || isRealReallyInt32(e2)) {
     return(`+.Date`(e1, e2))
     # IDate doesn't support fractional days; revert to base Date
   }
@@ -120,7 +120,7 @@ round.IDate = function(x, digits=c("weeks", "months", "quarters", "years"), ...)
   if (inherits(e2, "difftime"))
     internal_error("difftime objects may not be subtracted from IDate, but Ops dispatch should have intervened to prevent this") # nocov
 
-  if ( isReallyReal(e2) ) {
+  if ( isRealReallyInt32(e2) ) {
     # IDate deliberately doesn't support fractional days so revert to base Date
     return(base::`-.Date`(as.Date(e1), e2))
     # can't call base::.Date directly (last line of base::`-.Date`) as tried in PR#3168 because
diff --git a/R/bmerge.R b/R/bmerge.R
@@ -92,14 +92,14 @@ bmerge = function(i, x, icols, xcols, roll, rollends, nomatch, mult, ops, verbos
     if (xclass=="integer64" || iclass=="integer64") {
       nm = c(iname, xname)
       if (xclass=="integer64") { w=i; wc=ic; wclass=iclass; } else { w=x; wc=xc; wclass=xclass; nm=rev(nm) }  # w is which to coerce
-      if (wclass=="integer" || (wclass=="double" && !isReallyReal(w[[wc]], vs='i64'))) {
+      if (wclass=="integer" || (wclass=="double" && !isRealReallyInt64(w[[wc]]))) {
         if (verbose) catf("Coercing %s column %s%s to type integer64 to match type of %s.\n", wclass, nm[1L], if (wclass=="double") " (which has integer64 representation, e.g. no fractions)" else "", nm[2L])
         set(w, j=wc, value=bit64::as.integer64(w[[wc]]))
       } else stopf("Incompatible join types: %s is type integer64 but %s is type double and cannot be coerced to integer64 (e.g. has fractions)", nm[2L], nm[1L])
     } else {
       # just integer and double left
       if (iclass=="double") {
-        if (!isReallyReal(i[[ic]])) {
+        if (!isRealReallyInt32(i[[ic]])) {
           # common case of ad hoc user-typed integers missing L postfix joining to correct integer keys
           # we've always coerced to int and returned int, for convenience.
           if (verbose) catf("Coercing double column %s (which contains no fractions) to type integer to match type of %s.\n", iname, xname)
diff --git a/R/data.table.R b/R/data.table.R
@@ -3240,9 +3240,9 @@ is_constantish = function(q, check_singleton=FALSE) {
       if (length(RHS) != nrow(x)) stopf("RHS of %s is length %d which is not 1 or nrow (%d). For robustness, no recycling is allowed (other than of length 1 RHS). Consider %%in%% instead.", operator, length(RHS), nrow(x))
       return(NULL) # DT[colA == colB] regular element-wise vector scan
     }
-    if ( mode(x[[col]]) != mode(RHS) ||                # mode() so that doubleLHS/integerRHS and integerLHS/doubleRHS!isReallyReal are optimized (both sides mode 'numeric')
+    if ( mode(x[[col]]) != mode(RHS) ||                # mode() so that doubleLHS/integerRHS and integerLHS/doubleRHS!isRealReallyInt32 are optimized (both sides mode 'numeric')
          is.factor(x[[col]])+is.factor(RHS) == 1L ||   # but factor is also mode 'numeric' so treat that separately
-         is.integer(x[[col]]) && isReallyReal(RHS) ) { # and if RHS contains fractions then don't optimize that as bmerge truncates the fractions to match to the target integer type
+         is.integer(x[[col]]) && isRealReallyInt32(RHS) ) { # and if RHS contains fractions then don't optimize that as bmerge truncates the fractions to match to the target integer type
       # re-direct non-matching type cases to base R, as data.table's binary
       # search based join is strict in types. #957, #961 and #1361
       # the mode() checks also deals with NULL since mode(NULL)=="NULL" and causes this return, as one CRAN package (eplusr 0.9.1) relies on
diff --git a/R/wrappers.R b/R/wrappers.R
@@ -17,7 +17,7 @@ colnamesInt = function(x, cols, check_dups=FALSE, skip_absent=FALSE) .Call(Ccoln
 
 testMsg = function(status=0L, nx=2L, nk=2L) .Call(CtestMsgR, as.integer(status)[1L], as.integer(nx)[1L], as.integer(nk)[1L])
 
-isRealReallyInt = function(x) .Call(CisRealReallyIntR, x)
-isReallyReal = function(x, vs='i32') .Call(CisReallyReal, x, identical(vs, 'i64'))
+isRealReallyInt32 = function(x) .Call(CisRealReallyInt32R, x)
+isRealReallyInt64 = function(x) .Call(CisRealReallyInt64R, x)
 
 coerceAs = function(x, as, copy=TRUE) .Call(CcoerceAs, x, as, copy)
diff --git a/inst/tests/tests.Rraw b/inst/tests/tests.Rraw
@@ -56,8 +56,7 @@ if (exists("test.data.table", .GlobalEnv, inherits=FALSE)) {
   internal_error = data.table:::internal_error
   is_na = data.table:::is_na
   is.sorted = data.table:::is.sorted
-  isReallyReal = data.table:::isReallyReal
-  isRealReallyInt = data.table:::isRealReallyInt
+  isRealReallyInt32 = data.table:::isRealReallyInt32
   is_utc = data.table:::is_utc
   melt.data.table = data.table:::melt.data.table  # for test 1953.4
   messagef = data.table:::messagef
@@ -7344,22 +7343,22 @@ if (test_bit64) {
 X = list(a = 4:1, b=runif(4))
 test(1513, setkey(as.data.table(X), a), setDT(X, key="a"))
 
-# Adding tests for `isReallyReal`
+# Adding tests for `isRealReallyInt32`
 x = as.numeric(sample(10))
-test(1514.1, isReallyReal(x), 0L)
+test(1514.1, isRealReallyInt32(x), TRUE)
 x = as.numeric(sample(c(1:5, NA)))
-test(1514.2, isReallyReal(x), 0L) # NAs in numeric can be coerced to integer NA without loss
+test(1514.2, isRealReallyInt32(x), TRUE) # NAs in numeric can be coerced to integer NA without loss
 x = c(1:2, NaN, NA)
-test(1514.3, isReallyReal(x), 3L)
+test(1514.3, isRealReallyInt32(x), FALSE)
 x = c(1:2, Inf, NA)
-test(1514.4, isReallyReal(x), 3L)
+test(1514.4, isRealReallyInt32(x), FALSE)
 x = c(1:2, -Inf, NA)
-test(1514.5, isReallyReal(x), 3L)
+test(1514.5, isRealReallyInt32(x), FALSE)
 x = runif(2)
-test(1514.6, isReallyReal(x), 1L)
+test(1514.6, isRealReallyInt32(x), FALSE)
 x = numeric()
-test(1514.7, isReallyReal(x), 0L)
-test(1514.8, isReallyReal(9L), 0L)
+test(1514.7, isRealReallyInt32(x), TRUE)
+test(1514.8, isRealReallyInt32(9L), TRUE)
 
 # #1091
 options(datatable.prettyprint.char = 5L)
@@ -17590,18 +17589,18 @@ test(2204, as.data.table(mtcars, keep.rownames='model', key='model'),
 
 # 2205 tested nanotime moved to other.Rraw 27, #5516
 
-# isRealReallyInt, #3966
-test(2206.01, isRealReallyInt(c(-2147483647.0, NA, 0.0, 2147483647.0)), TRUE)
-test(2206.02, isRealReallyInt(2147483648.0), FALSE) # >INT_MAX
-test(2206.03, isRealReallyInt(-2147483648.0), FALSE) # <=INT_MIN since INT_MIN==NA_integer_
-test(2206.04, isRealReallyInt(c(5,-5,2147483648)), FALSE)  # test real last position
-test(2206.05, isRealReallyInt(NaN), FALSE)
-test(2206.06, isRealReallyInt(+Inf), FALSE)
-test(2206.07, isRealReallyInt(-Inf), FALSE)
-test(2206.08, isRealReallyInt(0.1), FALSE)
-test(2206.09, isRealReallyInt(numeric()), TRUE)
-test(2206.10, isRealReallyInt(9L), FALSE) # must be type double
-test(2206.11, isRealReallyInt(integer()), FALSE)
+# isRealReallyInt32, #3966
+test(2206.01, isRealReallyInt32(c(-2147483647.0, NA, 0.0, 2147483647.0)), TRUE)
+test(2206.02, isRealReallyInt32(2147483648.0), FALSE) # >INT_MAX
+test(2206.03, isRealReallyInt32(-2147483648.0), FALSE) # <=INT_MIN since INT_MIN==NA_integer_
+test(2206.04, isRealReallyInt32(c(5,-5,2147483648)), FALSE)  # test real last position
+test(2206.05, isRealReallyInt32(NaN), FALSE)
+test(2206.06, isRealReallyInt32(+Inf), FALSE)
+test(2206.07, isRealReallyInt32(-Inf), FALSE)
+test(2206.08, isRealReallyInt32(0.1), FALSE)
+test(2206.09, isRealReallyInt32(numeric()), TRUE)
+test(2206.10, isRealReallyInt32(9L), FALSE) # must be type double
+test(2206.11, isRealReallyInt32(integer()), FALSE)
 
 # dcast supports complex value to cast, #4855
 DT = CJ(x=1:3, y=letters[1:2])
diff --git a/src/between.c b/src/between.c
@@ -30,8 +30,8 @@ SEXP between(SEXP x, SEXP lower, SEXP upper, SEXP incbounds, SEXP NAboundsArg, S
   const bool verbose = GetVerbose();
 
   if (isInteger(x)) {
-    if ((isInteger(lower) || isRealReallyInt(lower)) &&
-        (isInteger(upper) || isRealReallyInt(upper))) { // #3517 coerce to num to int when possible
+    if ((isInteger(lower) || isRealReallyInt32(lower)) &&
+        (isInteger(upper) || isRealReallyInt32(upper))) { // #3517 coerce to num to int when possible
       if (!isInteger(lower)) {
         lower = PROTECT(coerceVector(lower, INTSXP)); nprotect++;
       }
diff --git a/src/data.table.h b/src/data.table.h
@@ -243,9 +243,10 @@ SEXP coalesce(SEXP x, SEXP inplace);
 // utils.c
 bool within_int32_repres(double x);
 bool within_int64_repres(double x);
-bool isRealReallyInt(SEXP x);
-SEXP isRealReallyIntR(SEXP x);
-SEXP isReallyReal(SEXP x, SEXP i64);
+bool isRealReallyInt32(SEXP x);
+SEXP isRealReallyInt32R(SEXP x);
+bool isRealReallyInt64(SEXP x);
+SEXP isRealReallyInt64R(SEXP x);
 bool allNA(SEXP x, bool errorForBadType);
 SEXP colnamesInt(SEXP x, SEXP cols, SEXP check_dups, SEXP skip_absent);
 bool INHERITS(SEXP x, SEXP char_);
diff --git a/src/forder.c b/src/forder.c
@@ -595,12 +595,12 @@ SEXP forder(SEXP DT, SEXP by, SEXP retGrpArg, SEXP retStatsArg, SEXP sortGroupsA
       if (INHERITS(x, char_integer64)) {
         range_i64((int64_t *)REAL(x), nrow, &min, &max, &na_count);
       } else {
-        if (verbose && INHERITS(x, char_Date) && INTEGER(isReallyReal(x))[0]==0) {
-          Rprintf(_("\n*** Column %d passed to forder is a date stored as an 8 byte double but no fractions are present. Please consider a 4 byte integer date such as IDate to save space and time.\n"), col+1);
-          // Note the (slightly expensive) isReallyReal will only run when verbose is true. Prefix '***' just to make it stand out in verbose output
+        if (verbose && INHERITS(x, char_Date) && isRealReallyInt32(x)) {
+          // Note the (slightly expensive) isRealReallyInt32 will only run when verbose is true. Prefix '***' just to make it stand out in verbose output
           // In future this could be upgraded to option warning. But I figured that's what we use verbose to do (to trace problems and look for efficiencies).
           // If an automatic coerce is desired (see discussion in #1738) then this is the point to do that in this file. Move the INTSXP case above to be
           // next, do the coerce of Date to integer now to a tmp, and then let this case fall through to INTSXP in the same way as CPLXSXP falls through to REALSXP.
+          Rprintf(_("\n*** Column %d passed to forder is a date stored as an 8 byte double but no fractions are present. Please consider a 4 byte integer date such as IDate to save space and time.\n"), col+1);
         }
         range_d(REAL(x), nrow, &min, &max, &na_count, &infnan_count);
         if (min==0 && na_count<nrow) { min=3; max=4; } // column contains no finite numbers and is not-all NA; create dummies to yield positive min-2 later
diff --git a/src/frollR.c b/src/frollR.c
@@ -229,7 +229,7 @@ SEXP frollapplyR(SEXP fun, SEXP obj, SEXP k, SEXP fill, SEXP align, SEXP rho) {
 
   if (!isInteger(k)) {
     if (isReal(k)) {
-      if (isRealReallyInt(k)) {
+      if (isRealReallyInt32(k)) {
         SEXP ik = PROTECT(coerceVector(k, INTSXP)); protecti++;
         k = ik;
       } else {
diff --git a/src/init.c b/src/init.c
@@ -101,8 +101,8 @@ R_CallMethodDef callMethods[] = {
 {"Cshift", (DL_FUNC) &shift, -1},
 {"Ctranspose", (DL_FUNC) &transpose, -1},
 {"CanyNA", (DL_FUNC) &anyNA, -1},
-{"CisReallyReal", (DL_FUNC) &isReallyReal, -1},
-{"CisRealReallyIntR", (DL_FUNC) &isRealReallyIntR, -1},
+{"CisRealReallyInt32R", (DL_FUNC) &isRealReallyInt32R, -1},
+{"CisRealReallyInt64R", (DL_FUNC) &isRealReallyInt64R, -1},
 {"Csetlevels", (DL_FUNC) &setlevels, -1},
 {"Crleid", (DL_FUNC) &rleid, -1},
 {"Cgmedian", (DL_FUNC) &gmedian, -1},
diff --git a/src/utils.c b/src/utils.c
@@ -11,7 +11,7 @@ bool within_int64_repres(double x) {
   return R_FINITE(x) && x <= (double)INT64_MAX && x >= (double)INT64_MIN;
 }
 
-static R_xlen_t firstNonInt(SEXP x) {
+static R_xlen_t firstNonInt32(SEXP x) {
   R_xlen_t n=xlength(x), i=0;
   const double *dx = REAL(x);
   while (i<n &&
@@ -33,23 +33,22 @@ static R_xlen_t firstNonInt64(SEXP x) {
   return i==n ? 0 : i+1;
 }
 
-bool isRealReallyInt(SEXP x) {
-  return isReal(x) ? firstNonInt(x)==0 : false;
-  // used to error if not passed type double but this needed extra is.double() calls in calling R code
-  // which needed a repeat of the argument. Hence simpler and more robust to return false when not type double.
+// used to error if not passed type double but this needed extra is.double() calls in calling R code
+// which needed a repeat of the argument. Hence simpler and more robust to return false when not type double.
+bool isRealReallyInt32(SEXP x) {
+  return isReal(x) ? firstNonInt32(x)==0 : false;
 }
 
-SEXP isRealReallyIntR(SEXP x) {
-  return ScalarLogical(isRealReallyInt(x));
+SEXP isRealReallyInt32R(SEXP x) {
+  return ScalarLogical(isRealReallyInt32(x));
 }
 
-// return the 1-based location of first element which is really real (i.e. not an integer) otherwise 0 (false)
-SEXP isReallyReal(SEXP x, SEXP i64) {
-  if (LOGICAL(i64)[0]) {
-    return ScalarInteger(isReal(x) ? firstNonInt64(x) : 0);
-  } else {
-    return ScalarInteger(isReal(x) ? firstNonInt(x) : 0);
-  }
+bool isRealReallyInt64(SEXP x) {
+  return isReal(x) ? firstNonInt64(x)==0 : false;
+}
+
+SEXP isRealReallyInt64R(SEXP x) {
+  return ScalarLogical(isRealReallyInt64(x));
 }
 
 bool allNA(SEXP x, bool errorForBadType) {
@@ -140,7 +139,7 @@ SEXP colnamesInt(SEXP x, SEXP cols, SEXP check_dups, SEXP skip_absent) {
       } else
         ricols = cols;
     } else if (isReal(cols)) {
-      if (!isRealReallyInt(cols))
+      if (!isRealReallyInt32(cols))
         error(_("argument specifying columns is type 'double' and one or more items in it are not whole integers"));
       ricols = PROTECT(coerceVector(cols, INTSXP)); protecti++;
     }
