Calculate power for int64 exponent precisely

NEWS.md

@@ -37,6 +37,7 @@
 
 1. `as.integer64.integer64` returns a plain `integer64` vector stripped of any attributes. This is consistent with R like behavior, e.g. `as.integer.integer`.
 1. `%/%` matches base R/Knuth behavior of taking the `floor()` of a result, where before truncation was towards zero. For example, `as.integer64(-10L) %/% as.integer64(7L)` now gives `-2L`, not `-1L`. This is consistent with `-10L %/% 7L` in base R. Consequently, `%%` is also affected, e.g. `as.integer64(-10L) %% as.integer64(7L)` now gives `4L`, not `-3L`, consistent with `-10L %% 7L` in base R.
+1. `^.integer64` with integer or integer64 exponent now calculates the power precisely and returns an overflow warning, if an overflow appears.
 
 ## NEW FEATURES
 
@@ -76,6 +77,7 @@
 1. `[.integer64` now runs faster and correctly regarding `NA` and arrays (#176). Thanks @hcirellu.
 1. `integer64() %in% 1L` no longer warns (#265). Thanks @hcirellu.
 1. `match.integer64(..., method="orderpos")` and `duplicated.integer64(..., method="orderdup")` no longer fail with "object 's' not found" (#58).
+1. `^.integer64` with integer or integer64 exponent now calculates the power precisely and returns an overflow warning, if an overflow appears (#288).
 
 ## NOTES
 

R/ops64.R

@@ -14,6 +14,9 @@
 #'
 #' @param e1,e2,x numeric or complex vectors or objects which can be coerced to such, or other objects for which methods have been written for - especially 'integer64' vectors.
 #'
+#' @details 
+#' [`^`] with 'integer' or 'integer64' exponent now calculates the power precisely and returns an overflow warning, if an overflow appears.
+#' 
 #' @returns
 #'   [`&`], [`|`], [`!`], [`!=`], [`==`], [`<`], [`<=`], [`>`], [`>=`] return a logical vector
 #'

src/integer64.c

@@ -364,10 +364,10 @@ SEXP power_integer64_integer64(SEXP e1_, SEXP e2_, SEXP ret_){
   long long * e1 = (long long *) REAL(e1_);
   long long * e2 = (long long *) REAL(e2_);
   long long * ret = (long long *) REAL(ret_);
-  long double longret;
+  long long base, exp, intermediate;
   Rboolean naflag = FALSE;
     mod_iterate(n1, n2, i1, i2) {
-        POW64(e1[i1],e2[i2],ret[i],naflag, longret)
+        POW64(e1[i1],e2[i2],ret[i],naflag,base,exp,intermediate)
     }
     if (naflag)warning(INTEGER64_OVERFLOW_WARNING);
   return ret_;

src/integer64.h

@@ -102,16 +102,28 @@
           ret = llroundl(longret); \
     }
 
-#define POW64(e1,e2,ret,naflag, longret) \
+#define POW64(e1,e2,ret,naflag,base,exp,intermediate) \
     if (e1 == NA_INTEGER64 || e2 == NA_INTEGER64) \
         ret = NA_INTEGER64; \
     else { \
-        longret = pow(e1, (long double) e2); \
-        if (isnan(longret)){ \
-          naflag = TRUE; \
-          ret = NA_INTEGER64; \
-        }else \
-          ret = llroundl(longret); \
+        if (e2 >= 0 || e1 == 1 || e1 == -1) { \
+            ret = 1; \
+            base = e1; \
+            exp = e2; \
+            while (exp > 0) { \
+                if (exp % 2 == 1) { \
+                    intermediate = ret; \
+                    ret *= base; \
+                    if (!GOODIPROD64(intermediate, base, ret)) { \
+                        ret = NA_INTEGER64; \
+                        naflag = TRUE; \
+                        break; \
+                    } \
+                } \
+                base *= base; \
+                exp >>= 1; \
+            } \
+        } \
     }
 
 #define POW64REAL(e1,e2,ret,naflag,longret) \

tests/testthat/test-ops64.R

@@ -210,14 +210,17 @@ with_parameters_test_that("{operator} with integer64 vs {class} (returning integ
 
   op = match.fun(operator)
   maybe_cast = if (operator %in% c("+", "-", "*", "^", "%%", "%/%")) as.integer64 else identity
+  maybe_cast_argument = if (operator == "^") as.double else identity
 
   expected = tryCatch(maybe_cast(op(x32, y)), error=conditionMessage)
-  actual = tryCatch(op(x64, y), error=conditionMessage)
+  actual = tryCatch(op(x64, maybe_cast_argument(y)), error=conditionMessage)
   expect_identical(actual, expected)
 
-  expected = tryCatch(maybe_cast(op(y, x32)), error=conditionMessage)
-  actual = tryCatch(op(y, x64), error=conditionMessage)
-  expect_identical(actual, expected)
+  if (operator != "^") {
+    expected = tryCatch(maybe_cast(op(y, x32)), error=conditionMessage)
+    actual = tryCatch(op(y, x64), error=conditionMessage)
+    expect_identical(actual, expected)
+  }
 }, 
   .cases = expand.grid(
     operator=c("+", "-", "*", "/", "^", "%%", "%/%", "<", "<=", "==", ">=", ">", "!=", "&", "|", "xor"),
@@ -250,3 +253,19 @@ with_parameters_test_that("{operator} with integer64 vs. {class} (not returning
     class = c("complex", "Date", "POSIXct", "POSIXlt", "difftime")
   )
 )
+
+test_that("power with integer64", {
+  # within integer range
+  x = as.integer(sqrt(.Machine$integer.max))
+  x = seq(-x, x)
+  expect_identical(as.integer64(x)^2L, as.integer64(x^2L))
+  expect_identical(as.integer64(x)^2, as.integer64(x^2))
+
+  # within integer64 range, which fails with double exponent
+  expect_identical(as.integer64("2147483650")^2L, as.integer64("4611686027017322500"))
+  expect_identical(as.integer64("-2147483650")^2L, as.integer64("4611686027017322500"))
+  expect_identical(as.integer64("94906267")^2L, as.integer64("94906267")*as.integer64("94906267"))
+
+  expect_warning(expect_identical(as.integer64("2147483650")^3L, NA_integer64_), "NAs produced by integer64 overflow")
+})
+