diff --git a/NEWS.md b/NEWS.md index c58f5e2b..ad906c63 100644 --- a/NEWS.md +++ b/NEWS.md @@ -63,6 +63,7 @@ 1. `union`, `setdiff`, `intersect`, `setequal` and `is.element` get an overload to work correctly with `integer64` (#182). 1. The methods of the 'Ops' group (e.g. `+`, `&`, `==`) now support dispatch for both arguments so that e.g. `difftime * integer64` works consistent to R (#179). Thanks @hcirellu. Note that this relies on `chooseOpsMethod()` and thus R 4.3.0. 1. `c.integer64`, `cbind.integer64` and `rbind.integer64` now support combining with lists and recursion as `base::c`, `base::cbind` and `base::rbind` do (#252). In addition, by setting the option `bit64.promoteInteger64ToCharacter=TRUE` the methods return character if integer64 and character are combined. Thanks @hcirellu. +1. The result of `table` with multiple inputs including `integer64` is now ordered according to `integer64` values for the corresponding input (#236). Thanks @hcirellu. ## BUG FIXES diff --git a/R/highlevel64.R b/R/highlevel64.R index 4cd9fd0c..6f391123 100644 --- a/R/highlevel64.R +++ b/R/highlevel64.R @@ -2115,9 +2115,6 @@ table = function(..., exclude=if (useNA == "no") c(NA, NaN), useNA=c("no", "ifan else sel = !names(dots) %in% c("return", "order", "nunique", "method") is_int64 = vapply(dots[sel], is.integer64, logical(1L), USE.NAMES=FALSE) - is_int = vapply(dots[sel], is.integer, logical(1L), USE.NAMES=FALSE) - # TODO(#236): avoid this workaround to hack S3 dispatch. For now, - # we only use table.integer64() when we are sure there is no information loss (coercion). sys_call = match.call() sel = which(vapply(sys_call[seq_along(dots) + 1L], is.symbol, FALSE)) + 1L if (length(sel)) { @@ -2139,7 +2136,7 @@ table = function(..., exclude=if (useNA == "no") c(NA, NaN), useNA=c("no", "ifan pf = parent.frame() # add unused function `list.names` to eliminate CMD check NOTE about missing function definition. list.names = function(...) {} - if (length(dots) && any(is_int64) && all(is_int64 | is_int)) { + if (length(dots) && any(is_int64)) { sys_call[[1L]] = table.integer64 withCallingHandlers_and_choose_call(eval(sys_call, envir=pf), c("table", "table.default"), "table.integer64") } else { @@ -2211,9 +2208,15 @@ table.integer64 = function(..., if (!N) stop("nothing to tabulate", domain="R-base") - # table(as.integer64(1L), "a") is dispatched to table.integer64, but should be handled by table.default - if (!all(vapply(seq_len(N), function(ii) {el = A(ii); is.integer64(el) || is.integer(el)}, logical(1L)))) - return(NextMethod()) + # table(as.integer64(1L), "a") is dispatched to table.integer64, but should be handled by table.default with integer64 already as factor + if (!all(vapply(seq_len(N), function(ii) {el = A(ii); is.integer64(el) || is.integer(el)}, logical(1L)))) { + useNA = match.arg(useNA) + ret = withCallingHandlers_and_choose_call( + do.call("table", c(lapply(seq_len(N), function(ii) {val = A(ii); if (is.integer64(val)) factor(val, exclude=NULL) else val}), list(exclude=exclude, useNA=useNA, dnn=dnn, deparse.level=deparse.level))), + c("table", "table.integer64") + ) + return(ret) + } if (N == 1L && is.list(A(1L))) { args = A(1L) # nolint: object_overwrite_linter. This code should probably be refactored anyway. diff --git a/tests/testthat/test-highlevel64.R b/tests/testthat/test-highlevel64.R index 25c6bec5..d6a1dd32 100644 --- a/tests/testthat/test-highlevel64.R +++ b/tests/testthat/test-highlevel64.R @@ -576,6 +576,14 @@ test_that("table dispatch integer64 and 'higher' types and factors", { expect_identical(table(1.0+1.0i, as.integer64(1L)), table(1.0+1.0i, 1L)) }) +test_that("table dispatch to default with integer64 correctly coerced to factor", { + x = c(132724613L, -2143220989L, -1L, NA, 1L) + y = c(TRUE, FALSE) + expect_identical(table(x=as.integer64(x), rep_len(y, length(x))), table(x, rep_len(y, length(x)))) + expect_identical(table(x=as.integer64(x), rep_len(y, length(x)), useNA="ifany"), table(x, rep_len(y, length(x)), useNA="ifany")) + expect_identical(table(x=as.integer64(x), rep_len(y, length(x)), exclude=NULL), table(x, rep_len(y, length(x)), exclude=NULL)) +}) + test_that("implicit tests from ?match work", { x = as.integer64(sample(c(rep(NA, 9), 0:9), 32, TRUE)) table = as.integer64(sample(c(rep(NA, 9), 1:9), 32, TRUE))