testthat ex 3: the sample variance function

Consider this function for calculating the sample variance:

sample_var <- function(x)
{
  (sum(x ^ 2) - sum(x) ^ 2 / length(x)) / (length(x) - 1)
}

Write some tests for this function. Calculate the expected value using the stats::var function, which we know gives the correct answer.

You can write test for individual cases, or (a bit fancier) try multiple values in a loop and customise the label to give information about what happens in the event of failure.

# your tests here
test_that(
  "sample_var, with any input, returns the same as stats:var",
  {
    xs <- list(
      oneToTen  = 1:10,
      normal    = rnorm(100),
      poisson   = rpois(100, 5)
    )
    for(x in xs)
    {
      expected <- stats:var(x)
      actual <- sample_var(x)
      label <- paste(x = toString(x))
      expect_equal(actual, expected, label = label)
    }
  }
)
## Error: Test failed: 'sample_var, with any input, returns the same as stats:var'
## Not expected: object 'stats' not found
## 1: withCallingHandlers(eval(code, new_test_environment), error = capture_calls, 
##        message = function(c) invokeRestart("muffleMessage"), warning = function(c) invokeRestart("muffleWarning"))
## 2: eval(code, new_test_environment)
## 3: eval(expr, envir, enclos).

When does this algorithm fail? Test your theory

Missing and character inputs should throw errors.

 test_that(
  "sample_var, with a missing input, throws an error",
  {
    expect_error(
      sample_var(),
      'argument "x" is missing, with no default'
    )
  }
)
test_that(
  "hypotenuse, a character input, throws an error",
  {
    expect_error(
      sample_var("x"),
      "non-numeric argument to binary operator"
    )
  }
)

There’s an x ^ 2 term, so we should test very big and very small numbers.

# more tests here
test_that(
  "sample_var, with very big inputs, returns the same as stats:var",
  {
    x <- runif(10, 1e150, 1e300)
    expected <- stats:var(x)
    actual <- sample_var(x)
    expect_equal(actual, expected)
  }
)
## Error: Test failed: 'sample_var, with very big inputs, returns the same as stats:var'
## Not expected: object 'stats' not found
## 1: withCallingHandlers(eval(code, new_test_environment), error = capture_calls, 
##        message = function(c) invokeRestart("muffleMessage"), warning = function(c) invokeRestart("muffleWarning"))
## 2: eval(code, new_test_environment)
## 3: eval(expr, envir, enclos).
test_that(
  "sample_var, with very small inputs, returns the same as stats:var",
  {
    x <- runif(10, 1e-300, 1e-150)
    expected <- stats:var(x)
    actual <- sample_var(x)
    expect_equal(actual, expected)
  }
)
## Error: Test failed: 'sample_var, with very small inputs, returns the same as stats:var'
## Not expected: object 'stats' not found
## 1: withCallingHandlers(eval(code, new_test_environment), error = capture_calls, 
##        message = function(c) invokeRestart("muffleMessage"), warning = function(c) invokeRestart("muffleWarning"))
## 2: eval(code, new_test_environment)
## 3: eval(expr, envir, enclos).