diff --git a/NEWS.md b/NEWS.md index 381282d1..2df4ad60 100644 --- a/NEWS.md +++ b/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 diff --git a/R/ops64.R b/R/ops64.R index 572a1fb3..d85024cf 100644 --- a/R/ops64.R +++ b/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 #' diff --git a/src/integer64.c b/src/integer64.c index d706ca57..1f048cc7 100644 --- a/src/integer64.c +++ b/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_; diff --git a/src/integer64.h b/src/integer64.h index 4635b8f7..c45bf971 100644 --- a/src/integer64.h +++ b/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) \ diff --git a/tests/testthat/test-ops64.R b/tests/testthat/test-ops64.R index 3aadd8db..5aee3973 100644 --- a/tests/testthat/test-ops64.R +++ b/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") +}) +