From 8bdbe679b1f0f1715924e616d3c4fe71a0a696c7 Mon Sep 17 00:00:00 2001 From: "James P. Howard, II" Date: Thu, 7 Sep 2023 21:00:04 -0400 Subject: [PATCH] tests(sum): Revised unit testing for summation algorithms --- R/naivesum.R | 56 +++++++++++++++++++++++----------- tests/testthat/test-kahansum.R | 32 +++++++++++++++++++ tests/testthat/test-naivesum.R | 32 +++++++++++++++++++ tests/testthat/test-pwisesum.R | 32 +++++++++++++++++++ tests/testthat/test-sum.R | 40 ------------------------ 5 files changed, 135 insertions(+), 57 deletions(-) create mode 100644 tests/testthat/test-kahansum.R create mode 100644 tests/testthat/test-naivesum.R create mode 100644 tests/testthat/test-pwisesum.R delete mode 100644 tests/testthat/test-sum.R diff --git a/R/naivesum.R b/R/naivesum.R index 91f0fd1..61e1a57 100644 --- a/R/naivesum.R +++ b/R/naivesum.R @@ -62,36 +62,58 @@ #' @rdname summation #' @export naivesum <- function(x) { - s <- 0 - n <- length(x) + s <- 0 + n <- length(x) - for(i in 1:n) - s <- s + x[i] + if (any(n == 0, is.null(0))) { return(s) + } + + stopifnot(is.numeric(x)) + + for (i in 1:n) { + s <- s + x[i] + } + + return(s) } #' @rdname summation #' @export kahansum <- function(x) { - comp <- s <- 0 - n <- length(x) + comp <- s <- 0 + n <- length(x) - for(i in 1:n) { - y <- x[i] - comp - t <- x[i] + s - comp <- (t - s) - y - s <- t - } + if (any(n == 0, is.null(0))) { return(s) + } + + stopifnot(is.numeric(x)) + + for (i in 1:n) { + y <- x[i] - comp + t <- x[i] + s + comp <- (t - s) - y + s <- t + } + return(s) } #' @rdname summation #' @export pwisesum <- function(x) { - n <- length(x) + n <- length(x) + + if (any(n == 0, is.null(0))) { + return(0) + } + + stopifnot(is.numeric(x)) + + if (n == 1) { + return(x) + } - if(n == 1) - return(x) - m = floor(n / 2) - return(pwisesum(x[1:m]) + pwisesum(x[(m + 1):n])) + m <- floor(n / 2) + return(pwisesum(x[1:m]) + pwisesum(x[(m + 1):n])) } diff --git a/tests/testthat/test-kahansum.R b/tests/testthat/test-kahansum.R new file mode 100644 index 0000000..3b959c3 --- /dev/null +++ b/tests/testthat/test-kahansum.R @@ -0,0 +1,32 @@ +library("testthat") +context("kahansum") + +l <- 1:10^6 + +test_that("adds correctly", { + for (i in 1:5) { + n <- sample(l, 1) + bound <- sample(l, 2) + bound.u <- max(bound) - 10^6 / 2 + bound.l <- min(bound) - 10^6 / 2 + x <- runif(n, bound.l, bound.u) + expect_equal(kahansum(x), sum(x)) + } +}) + +test_that("edge cases like an empty vector", { + expect_equal(kahansum(c()), sum(c())) + expect_equal(kahansum(NULL), sum(NULL)) +}) + +test_that("edge cases like a single-element vector", { + expect_equal(kahansum(c(1)), sum(c(1))) +}) + +test_that("input unexpected types", { + expect_error(kahansum("string")) +}) + +test_that("for precision", { + expect_equal(kahansum(c(1e-10, 1, 1e-10)), sum(c(1e-10, 1, 1e-10)), tolerance = 1e-20) +}) diff --git a/tests/testthat/test-naivesum.R b/tests/testthat/test-naivesum.R new file mode 100644 index 0000000..c099e08 --- /dev/null +++ b/tests/testthat/test-naivesum.R @@ -0,0 +1,32 @@ +library("testthat") +context("naivesum") + +l <- 1:10^6 + +test_that("adds correctly", { + for (i in 1:5) { + n <- sample(l, 1) + bound <- sample(l, 2) + bound.u <- max(bound) - 10^6 / 2 + bound.l <- min(bound) - 10^6 / 2 + x <- runif(n, bound.l, bound.u) + expect_equal(naivesum(x), sum(x)) + } +}) + +test_that("edge cases like an empty vector", { + expect_equal(naivesum(c()), sum(c())) + expect_equal(naivesum(NULL), sum(NULL)) +}) + +test_that("edge cases like a single-element vector", { + expect_equal(naivesum(c(1)), sum(c(1))) +}) + +test_that("input unexpected types", { + expect_error(naivesum("string")) +}) + +test_that("for precision", { + expect_equal(naivesum(c(1e-10, 1, 1e-10)), sum(c(1e-10, 1, 1e-10)), tolerance = 1e-20) +}) diff --git a/tests/testthat/test-pwisesum.R b/tests/testthat/test-pwisesum.R new file mode 100644 index 0000000..c4c6afe --- /dev/null +++ b/tests/testthat/test-pwisesum.R @@ -0,0 +1,32 @@ +library("testthat") +context("pwisesum") + +l <- 1:10^6 + +test_that("adds correctly", { + for (i in 1:5) { + n <- sample(l, 1) + bound <- sample(l, 2) + bound.u <- max(bound) - 10^6 / 2 + bound.l <- min(bound) - 10^6 / 2 + x <- runif(n, bound.l, bound.u) + expect_equal(pwisesum(x), sum(x)) + } +}) + +test_that("edge cases like an empty vector", { + expect_equal(pwisesum(c()), sum(c())) + expect_equal(pwisesum(NULL), sum(NULL)) +}) + +test_that("edge cases like a single-element vector", { + expect_equal(pwisesum(c(1)), sum(c(1))) +}) + +test_that("input unexpected types", { + expect_error(pwisesum("string")) +}) + +test_that("for precision", { + expect_equal(pwisesum(c(1e-10, 1, 1e-10)), sum(c(1e-10, 1, 1e-10)), tolerance = 1e-20) +}) diff --git a/tests/testthat/test-sum.R b/tests/testthat/test-sum.R deleted file mode 100644 index 3496cf7..0000000 --- a/tests/testthat/test-sum.R +++ /dev/null @@ -1,40 +0,0 @@ -library("testthat") -context("sum") - -l <- 1:10^6 - -n <- sample(l, 1) -bound <- sample(l, 2) -bound.u <- max(bound) - 10^6 / 2 -bound.l <- min(bound) - 10^6 / 2 -x <- runif(n, bound.l, bound.u) -expect_equal(naivesum(x), sum(x)) -expect_equal(kahansum(x), sum(x)) -expect_equal(pwisesum(x), sum(x)) - -n <- sample(l, 1) -bound <- sample(l, 2) -bound.u <- max(bound) - 10^6 / 2 -bound.l <- min(bound) - 10^6 / 2 -x <- runif(n, bound.l, bound.u) -expect_equal(naivesum(x), sum(x)) -expect_equal(kahansum(x), sum(x)) -expect_equal(pwisesum(x), sum(x)) - -n <- sample(l, 1) -bound <- sample(l, 2) -bound.u <- max(bound) - 10^6 / 2 -bound.l <- min(bound) - 10^6 / 2 -x <- runif(n, bound.l, bound.u) -expect_equal(naivesum(x), sum(x)) -expect_equal(kahansum(x), sum(x)) -expect_equal(pwisesum(x), sum(x)) - -n <- sample(l, 1) -bound <- sample(l, 2) -bound.u <- max(bound) - 10^6 / 2 -bound.l <- min(bound) - 10^6 / 2 -x <- runif(n, bound.l, bound.u) -expect_equal(naivesum(x), sum(x)) -expect_equal(kahansum(x), sum(x)) -expect_equal(pwisesum(x), sum(x))