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).