fixed max(), min(), range() for multiple inputs if one is non-finite

NAMESPACE

@@ -28,6 +28,8 @@ S3method("|",integer64)
 S3method(abs,integer64)
 S3method(all,integer64)
 S3method(all.equal,integer64)
+S3method(allNA,default)
+S3method(allNA,integer64)
 S3method(any,integer64)
 S3method(aperm,integer64)
 S3method(as.bitstring,integer64)
@@ -45,6 +47,7 @@ S3method(as.integer64,integer64)
 S3method(as.integer64,logical)
 S3method(as.list,integer64)
 S3method(as.logical,integer64)
+S3method(base::anyNA,integer64)
 S3method(c,integer64)
 S3method(cbind,integer64)
 S3method(ceiling,integer64)
@@ -179,6 +182,7 @@ export(NA_integer64_)
 export(abs.integer64)
 export(all.equal.integer64)
 export(all.integer64)
+export(allNA)
 export(any.integer64)
 export(as.bitstring)
 export(as.bitstring.integer64)

NEWS.md

@@ -39,9 +39,14 @@
    Because there was no recorded direct usage for any of these, I am opting to just rip the band-aid
    off and un-export them in this release as opposed to waiting a full cycle more to do so.
 
+## BUG FIXES
+
+1. `min.integer64`, `max.integer64` and `range.integer64` now support `na.rm=TRUE` correctly when combining across mutliple inputs like `min(x, NA_integer64_, na.rm=TRUE)` (#142).
+
 ## NOTES
 
 1. {bit64} no longer prints any start-up messages through an `.onAttach()` hook (#106). Thanks @hadley for the request.
+2. `anyNA` is supported for `integer64` and `allNA` is added.
 
 # bit64 4.6.0-1 (2025-01-16)
 

R/integer64.R

@@ -277,8 +277,8 @@ NULL
 #'
 #' @examples
 #'   c(as.integer64(1), 2:6)
-#'   cbind(1:6, as.integer(1:6))
-#'   rbind(1:6, as.integer(1:6))
+#'   cbind(1:6, as.integer64(1:6))
+#'   rbind(1:6, as.integer64(1:6))
 #' @name c.integer64
 NULL
 
@@ -305,7 +305,7 @@ NULL
 #'
 #' Generating sequence of integer64 values
 #'
-#' @param from integer64 scalar (in order to dispatch the integer64 method of [seq()]
+#' @param from integer64 scalar (in order to dispatch the integer64 method of [seq()])
 #' @param to scalar
 #' @param by scalar
 #' @param length.out scalar
@@ -1387,74 +1387,123 @@ prod.integer64 <- function(..., na.rm=FALSE) {
   }
 }
 
+empty_or_all_na_values_with_naRm = function(x, na.rm) {
+  if (length(x) == 0L) return(TRUE)
+  na.rm && allNA(x)
+}
+
 #' @rdname sum.integer64
 #' @export
 min.integer64 = function(..., na.rm=FALSE) {
   l = list(...)
+  na.rm = isTRUE(na.rm)
+  ret = NULL
+  resEmptyOrAllNa = NULL
+
   if (length(l) == 1L) {
-    ret = .Call(C_min_integer64, l[[1L]], na.rm, double(1L))
-    oldClass(ret) = "integer64"
+    if (length(l[[1]]) > 0L) {
+      ret = .Call(C_min_integer64, l[[1L]], na.rm, double(1L))
+      oldClass(ret) = "integer64"
+    }
   } else {
-    ret = vapply(l, FUN.VALUE=integer64(1L), function(e) {
+    ret = vapply(Filter(length, l), FUN.VALUE=integer64(1L), function(e) {
       if (is.integer64(e)) {
         .Call(C_min_integer64, e, na.rm, double(1L))
       } else {
-        as.integer64(min(e, na.rm=na.rm))
+        suppressWarnings(as.integer64(min(e, na.rm=na.rm)))
       }
     })
     oldClass(ret) = "integer64"
-    ret = min(ret, na.rm=na.rm)
+    resEmptyOrAllNa = empty_or_all_na_values_with_naRm(ret, na.rm)
+    if (!resEmptyOrAllNa) {
+      ret = min(ret, na.rm=na.rm)
+      resEmptyOrAllNa = NULL
+    }
+  }
+  if (is.null(resEmptyOrAllNa))
+    resEmptyOrAllNa = empty_or_all_na_values_with_naRm(ret, na.rm)
+  if (resEmptyOrAllNa) {
+    ret = lim.integer64()[2L]
+    warning("no non-NA value, returning the highest possible integer64 value +", ret)
   }
-  if (!any(lengths(l)))
-    warning("no non-NA value, returning the highest possible integer64 value +", lim.integer64()[2L])
   ret
 }
 
 #' @rdname sum.integer64
 #' @export
 max.integer64 = function(..., na.rm=FALSE) {
   l = list(...)
+  na.rm = isTRUE(na.rm)
+  ret = NULL
+  resEmptyOrAllNa = NULL
+
   if (length(l) == 1L) {
-    ret = .Call(C_max_integer64, l[[1L]], na.rm, double(1L))
-    oldClass(ret) = "integer64"
+    if (length(l[[1]]) > 0L) {
+      ret = .Call(C_max_integer64, l[[1L]], na.rm, double(1L))
+      oldClass(ret) = "integer64"
+    }
   } else {
-    ret <- vapply(l, FUN.VALUE=integer64(1L), function(e) {
+    ret = vapply(Filter(length, l), FUN.VALUE=integer64(1L), function(e) {
       if (is.integer64(e)) {
         .Call(C_max_integer64, e, na.rm, double(1L))
       } else {
-        as.integer64(max(e, na.rm=na.rm))
+        suppressWarnings(as.integer64(max(e, na.rm=na.rm)))
       }
     })
     oldClass(ret) = "integer64"
-    ret = max(ret, na.rm=na.rm)
+    resEmptyOrAllNa = empty_or_all_na_values_with_naRm(ret, na.rm)
+    if (!resEmptyOrAllNa) {
+      ret = max(ret, na.rm=na.rm)
+      resEmptyOrAllNa = NULL
+    }
+  }
+  if (is.null(resEmptyOrAllNa))
+    resEmptyOrAllNa = empty_or_all_na_values_with_naRm(ret, na.rm)
+  if (resEmptyOrAllNa) {
+    ret = lim.integer64()[1L]
+    warning("no non-NA value, returning the lowest possible integer64 value ", ret)
   }
-  if (!any(lengths(l)))
-    warning("no non-NA value, returning the lowest possible integer64 value ", lim.integer64()[1L])
   ret
 }
 
 #' @rdname sum.integer64
 #' @export
 range.integer64 = function(..., na.rm=FALSE, finite=FALSE) {
-  if (finite)
+  l = list(...)
+  if (isTRUE(finite)) {
     na.rm = TRUE
-  l <- list(...)
+  } else {
+    na.rm = isTRUE(na.rm)
+  }
+  ret = NULL
+  resEmptyOrAllNa = NULL
+
   if (length(l) == 1L) {
-    ret = .Call(C_range_integer64, l[[1L]], na.rm, double(2L))
-    oldClass(ret) = "integer64"
+    if (length(l[[1]]) > 0L) {
+      ret = .Call(C_range_integer64, l[[1L]], na.rm, double(2L))
+      oldClass(ret) = "integer64"
+    }
   } else {
-    ret <- vapply(l, FUN.VALUE=integer64(2L), function(e) {
+    ret = vapply(Filter(length, l), FUN.VALUE=integer64(2L), function(e) {
       if (is.integer64(e)) {
         .Call(C_range_integer64, e, na.rm, double(2L))
       } else {
-        as.integer64(range(e, na.rm=na.rm))
+        suppressWarnings(as.integer64(range(e, na.rm=na.rm)))
       }
     })
     oldClass(ret) = "integer64"
-    ret = range(ret, na.rm=na.rm)
+    resEmptyOrAllNa = empty_or_all_na_values_with_naRm(ret, na.rm)
+    if (!resEmptyOrAllNa) {
+      ret = range(ret, na.rm=na.rm)
+      resEmptyOrAllNa = NULL
+    }
+  }
+  if (is.null(resEmptyOrAllNa))
+    resEmptyOrAllNa = empty_or_all_na_values_with_naRm(ret, na.rm)
+  if (resEmptyOrAllNa) {
+    ret = c(lim.integer64()[2L], lim.integer64()[1L])
+    warning("no non-NA value, returning c(+", ret[1L], ", ", ret[2L], ")")
   }
-  if (!any(lengths(l)))
-    warning("no non-NA value, returning c(+", lim.integer64()[2L], ", ", lim.integer64()[1L], ")")
   ret
 }
 
@@ -1704,3 +1753,27 @@ as.list.integer64 <- function(x, ...) {
   ret <- NextMethod("as.list", x, ...)
   .Call(C_as_list_integer64, ret)
 }
+
+
+#' @exportS3Method base::anyNA integer64
+anyNA.integer64 = function(x, recursive) {
+  .Call(C_r_ram_integer64_any_na, x=x)
+}
+
+
+#' @title Not Available / Missing Values
+#' @description The function allNA implements all(is.na(x)) in a possibly faster way for integer64
+#' @param x An R object to be tested.
+#'
+#' @export
+allNA = function(x) UseMethod("allNA")
+#' @exportS3Method allNA default
+allNA.default = function(x) {
+  warning("Please promote that `allNA()` is going to be added in package base in future R versions - similar to `anyNA()`. Falling back to `all(is.na(x))`.")
+  length(x) && all(is.na(x))
+}
+
+#' @exportS3Method allNA integer64
+allNA.integer64 = function(x) {
+  .Call(C_r_ram_integer64_all_na, x=x)
+}

src/init.c

@@ -67,6 +67,8 @@ extern SEXP r_ram_integer64_issorted_asc(SEXP);
 extern SEXP r_ram_integer64_mergeorder(SEXP, SEXP, SEXP, SEXP, SEXP);
 extern SEXP r_ram_integer64_mergesort(SEXP, SEXP, SEXP, SEXP);
 extern SEXP r_ram_integer64_mergesortorder(SEXP, SEXP, SEXP, SEXP, SEXP);
+extern SEXP r_ram_integer64_all_na(SEXP);
+extern SEXP r_ram_integer64_any_na(SEXP);
 extern SEXP r_ram_integer64_nacount(SEXP);
 extern SEXP r_ram_integer64_orderdup_asc(SEXP, SEXP, SEXP, SEXP);
 extern SEXP r_ram_integer64_orderfin_asc(SEXP, SEXP, SEXP, SEXP, SEXP);
@@ -180,6 +182,8 @@ static const R_CallMethodDef CallEntries[] = {
     {"r_ram_integer64_mergeorder",       (DL_FUNC) &r_ram_integer64_mergeorder,       5},
     {"r_ram_integer64_mergesort",        (DL_FUNC) &r_ram_integer64_mergesort,        4},
     {"r_ram_integer64_mergesortorder",   (DL_FUNC) &r_ram_integer64_mergesortorder,   5},
+    {"r_ram_integer64_all_na",           (DL_FUNC) &r_ram_integer64_all_na,           1},
+    {"r_ram_integer64_any_na",           (DL_FUNC) &r_ram_integer64_any_na,           1},
     {"r_ram_integer64_nacount",          (DL_FUNC) &r_ram_integer64_nacount,          1},
     {"r_ram_integer64_orderdup_asc",     (DL_FUNC) &r_ram_integer64_orderdup_asc,     4},
     {"r_ram_integer64_orderfin_asc",     (DL_FUNC) &r_ram_integer64_orderfin_asc,     5},

src/integer64.c

@@ -20,6 +20,7 @@
 #include <math.h> // floor
 #include <stdint.h>
 #include <stdlib.h> // strtoll
+#include <stdbool.h> // for boolean
 
 #include <R.h>
 #include <Rdefines.h>
@@ -680,61 +681,79 @@ SEXP min_integer64(SEXP e1_, SEXP na_rm_, SEXP ret_){
   long long i, n = LENGTH(e1_);
   long long * e1 = (long long *) REAL(e1_);
   long long * ret = (long long *) REAL(ret_);
+  bool onlyNas = true;
   ret[0] = MAX_INTEGER64;
     if (asLogical(na_rm_)){
         for(i=0; i<n; i++){
-            if (e1[i]!=NA_INTEGER64 && e1[i]<ret[0]){
+            if (e1[i]!=NA_INTEGER64){
+              onlyNas = false;
+              if (e1[i]<ret[0]){
                 ret[0] = e1[i];
-            }
+              }
+            } 
         }
     }else{
         for(i=0; i<n; i++){
             if (e1[i]==NA_INTEGER64){
                 ret[0] = NA_INTEGER64;
                 return ret_;
             }else{
+                onlyNas = false;       
                 if (e1[i]<ret[0])
                     ret[0] = e1[i];
             }
         }
     }
+  if (onlyNas){
+    ret[0] = NA_INTEGER64;
+  }
   return ret_;
 }
 
 SEXP max_integer64(SEXP e1_, SEXP na_rm_, SEXP ret_){
   long long i, n = LENGTH(e1_);
   long long * e1 = (long long *) REAL(e1_);
   long long * ret = (long long *) REAL(ret_);
+  bool onlyNas = true;
   ret[0] = MIN_INTEGER64;
     if (asLogical(na_rm_)){
         for(i=0; i<n; i++){
-            if (e1[i]!=NA_INTEGER64 && e1[i]>ret[0]){
+            if (e1[i]!=NA_INTEGER64){
+              onlyNas = false;
+              if (e1[i]>ret[0]){
                 ret[0] = e1[i];
-            }
+              }
+            } 
         }
     }else{
         for(i=0; i<n; i++){
             if (e1[i]==NA_INTEGER64){
                 ret[0] = NA_INTEGER64;
                 return ret_;
             }else{
+                onlyNas = false;       
                 if (e1[i]>ret[0])
                     ret[0] = e1[i];
             }
         }
     }
+  if (onlyNas){
+    ret[0] = NA_INTEGER64;
+  }
   return ret_;
 }
 
 SEXP range_integer64(SEXP e1_, SEXP na_rm_, SEXP ret_){
   long long i, n = LENGTH(e1_);
   long long * e1 = (long long *) REAL(e1_);
   long long * ret = (long long *) REAL(ret_);
+  bool onlyNas = true;
   ret[0] = MAX_INTEGER64;
   ret[1] = MIN_INTEGER64;
     if (asLogical(na_rm_)){
         for(i=0; i<n; i++){
             if (e1[i]!=NA_INTEGER64){
+                onlyNas = false;
                 if (e1[i]<ret[0])
                     ret[0] = e1[i];
                 if (e1[i]>ret[1])
@@ -747,13 +766,18 @@ SEXP range_integer64(SEXP e1_, SEXP na_rm_, SEXP ret_){
                 ret[0] = ret[1] = NA_INTEGER64;
                 return ret_;
             }else{
+                onlyNas = false;
                 if (e1[i]<ret[0])
                     ret[0] = e1[i];
                 if (e1[i]>ret[1])
                     ret[1] = e1[i];
             }
         }
     }
+  if (onlyNas){
+    ret[0] = NA_INTEGER64;
+    ret[1] = NA_INTEGER64;
+  }
   return ret_;
 }