From 91be59ff30d7ecef69ea28aef42ba2fb19d15d39 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Mon, 7 Oct 2024 21:23:03 -0700 Subject: [PATCH] moar --- R/integer64.R | 43 ++++++++++++--------------------- tests/testthat/test-integer64.R | 23 +++++++++++++++--- 2 files changed, 36 insertions(+), 30 deletions(-) diff --git a/R/integer64.R b/R/integer64.R index 7df2cf7..7a1715e 100644 --- a/R/integer64.R +++ b/R/integer64.R @@ -2571,32 +2571,28 @@ log2.integer64 <- function(x){ ret } -trunc.integer64 <- function(x, ...)x -floor.integer64 <- ceiling.integer64 <- function(x)x +trunc.integer64 <- function(x, ...) x +floor.integer64 <- ceiling.integer64 <- function(x) x -signif.integer64 <- function(x, digits=6L)x +signif.integer64 <- function(x, digits=6L) x -scale.integer64 <- function(x, center = TRUE, scale = TRUE)scale(as.double(x, keep.names=TRUE), center=center, scale=scale) +scale.integer64 <- function(x, center = TRUE, scale = TRUE) + scale(as.double(x, keep.names=TRUE), center=center, scale=scale) round.integer64 <- function(x, digits=0L){ - if (digits<0L){ - a <- attributes(x) - b <- 10L^round(-digits) - b2 <- b %/% 2L - d <- (x %/% b) - db <- d * b - r <- abs(x-db) - ret <- ifelse((r < b2) | (r == b2 & ((d %% 2L) == 0L)), db, db + sign(x)*b) - #a$class <- minusclass(a$class, "integer64") - attributes(ret) <- a - ret - }else - x + if (digits >= 0L) return(x) + a <- attributes(x) + b <- 10L^round(-digits) + b2 <- b %/% 2L + d <- (x %/% b) + db <- d * b + r <- abs(x-db) + ret <- ifelse((r < b2) | (r == b2 & ((d %% 2L) == 0L)), db, db + sign(x)*b) + #a$class <- minusclass(a$class, "integer64") + attributes(ret) <- a + ret } - - - any.integer64 <- function(..., na.rm = FALSE){ l <- list(...) if (length(l)==1L){ @@ -2646,8 +2642,6 @@ sum.integer64 <- function(..., na.rm = FALSE){ } } - - prod.integer64 <- function(..., na.rm = FALSE){ l <- list(...) if (length(l)==1L){ @@ -2667,7 +2661,6 @@ prod.integer64 <- function(..., na.rm = FALSE){ } } - min.integer64 <- function(..., na.rm = FALSE){ l <- list(...) noval <- TRUE @@ -2694,7 +2687,6 @@ min.integer64 <- function(..., na.rm = FALSE){ ret } - max.integer64 <- function(..., na.rm = FALSE){ l <- list(...) noval <- TRUE @@ -2721,7 +2713,6 @@ max.integer64 <- function(..., na.rm = FALSE){ ret } - range.integer64 <- function(..., na.rm = FALSE, finite = FALSE){ if (finite) na.rm = TRUE @@ -2750,7 +2741,6 @@ range.integer64 <- function(..., na.rm = FALSE, finite = FALSE){ ret } - lim.integer64 <- function(){ ret <- .Call(C_lim_integer64, double(2L)) oldClass(ret) <- "integer64" @@ -2782,7 +2772,6 @@ diff.integer64 <- function(x, lag=1L, differences=1L, ...){ ret } - cummin.integer64 <- function(x){ ret <- .Call(C_cummin_integer64, x, double(length(x))) oldClass(ret) <- "integer64" diff --git a/tests/testthat/test-integer64.R b/tests/testthat/test-integer64.R index aa93574..4b00e63 100644 --- a/tests/testthat/test-integer64.R +++ b/tests/testthat/test-integer64.R @@ -43,11 +43,11 @@ test_that("S3 class basics work", { test_that("indexing works", { x = as.integer64(1:10) - x[1] = 2 + x[1.0] = 2.0 x[2L] = 3L expect_identical(x, as.integer64(c(2:3, 3:10))) - x[[1]] = 3 + x[[1.0]] = 3.0 x[[2L]] = 4L expect_identical(x, as.integer64(c(3:4, 3:10))) @@ -55,7 +55,7 @@ test_that("indexing works", { expect_identical(x[[4L]], as.integer64(4L)) }) -test_that("arithmetic works", { +test_that("arithmetic & basic math works", { x = as.integer64(1:10) y = as.integer64(10:1) @@ -75,6 +75,23 @@ test_that("arithmetic works", { expect_identical(sqrt(as.integer64(c(0L, 1L, 4L, 9L))), as.numeric(0:3)) expect_identical(log(x), log(as.numeric(x))) expect_identical(log(as.integer64(c(1L, 2L, 4L, 8L)), base=2L), as.numeric(0:3)) + expect_identical(log2(as.integer64(c(1L, 2L, 4L, 8L))), as.numeric(0:3)) + # TODO(#48): Improve the numerical precision here. + expect_identical(log10(as.integer64(c(1L, 10L, 100L, 1000L))), as.numeric(0:3), tolerance=1e-7) + + expect_identical(trunc(x), x) + expect_identical(floor(x), x) + expect_identical(ceiling(x), x) + expect_identical(signif(x), x) + expect_identical(round(x), x) + + expect_identical(round(x, -1L), as.integer64(rep(c(0L, 10L), each=5L))) + + expect_identical(sum(x), as.integer64(55L)) + expect_identical(prod(x), as.integer64(factorial(10L))) + expect_identical(min(x), x[1L]) + expect_identical(max(x), x[10L]) + expect_identical(diff(x), as.integer64(rep(1L, 9L))) }) test_that("display methods work", {