tests(sum): Revised unit testing for summation algorithms

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]))
 }

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)
+})

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)
+})

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)
+})