From 3a3aeefb99f996c9fd7a77bbb224bc4019454a67 Mon Sep 17 00:00:00 2001 From: Chris Mainey Date: Thu, 14 Dec 2023 16:06:04 +0000 Subject: [PATCH] Added first attempt at tests as per #7. Related to #28, some test commented out in anticipation of input checks. --- tests/testthat.R | 12 ++++ tests/testthat/test-average_wait.R | 56 +++++++++++++++++ tests/testthat/test-queue_load.R | 54 +++++++++++++++++ tests/testthat/test-relief_capacity.R | 67 +++++++++++++++++++++ tests/testthat/test-target_capacity.R | 53 ++++++++++++++++ tests/testthat/test-target_queue_size.R | 50 +++++++++++++++ tests/testthat/test-waiting_list_pressure.R | 51 ++++++++++++++++ 7 files changed, 343 insertions(+) create mode 100644 tests/testthat.R create mode 100644 tests/testthat/test-average_wait.R create mode 100644 tests/testthat/test-queue_load.R create mode 100644 tests/testthat/test-relief_capacity.R create mode 100644 tests/testthat/test-target_capacity.R create mode 100644 tests/testthat/test-target_queue_size.R create mode 100644 tests/testthat/test-waiting_list_pressure.R diff --git a/tests/testthat.R b/tests/testthat.R new file mode 100644 index 0000000..d67dd81 --- /dev/null +++ b/tests/testthat.R @@ -0,0 +1,12 @@ +# This file is part of the standard setup for testthat. +# It is recommended that you do not modify it. +# +# Where should you do additional test configuration? +# Learn more about the roles of various files in: +# * https://r-pkgs.org/testing-design.html#sec-tests-files-overview +# * https://testthat.r-lib.org/articles/special-files.html + +library(testthat) +library(NHSRwaitinglist) + +test_check("NHSRwaitinglist") diff --git a/tests/testthat/test-average_wait.R b/tests/testthat/test-average_wait.R new file mode 100644 index 0000000..1e5ad61 --- /dev/null +++ b/tests/testthat/test-average_wait.R @@ -0,0 +1,56 @@ +# # Anticipated test from the error handling that Matt Dray is drafting +# test_that("function catches null values and reports error", { +# em <- "target_wait(): no error message when function is run with no inputs." +# expect_error(target_wait(), em) +# }) +# +# # Anticipated test from the error handling that Matt Dray is drafting +# test_that("function catches mismatched input lengths", { +# em <- "target_wait(): no error message when functions inputs are of different length." +# expect_error(target_wait(c(22,25,26), c(4, 3)), em) +# }) +# +# # Anticipated test from the error handling that Matt Dray is drafting +# test_that("it returns an error if either input aren't numeric", { +# in1 <- Sys.Date() +# in2 <- 4 +# +# em <- "target_wait(): all inputs must be numeric." +# expect_error(target_wait(in1, in2), em) +# }) + +test_that("it returns an expected result with fixed single values, against arithmetic", { + target_wait <- + em <- "average_wait(): aritmetic error with single value inputs." + expect_equal(average_wait(52, 4), 52/4) +}) + +test_that("it returns an expected result with fixed single values", { + target_wait <- + em <- "average_wait(): aritmetic error with single value inputs." + expect_equal(average_wait(52, 4), 13) +}) + + + +test_that("it returns an expected result with vector of fixed values", { + em <- "average_wait(): aritmetic error with vector of values as inputs." + expect_equal( + average_wait( + c(35, 30, 52), + c(4,4,6) + ) + , c(8.75, 7.5, 8.6666667) + ) +}) + + +test_that("it returns the same length output as provided on input", { + n <- round(runif(1, 0,30)) + in1 <- rnorm(n = n, 50, 20) + in2 <- rnorm(n = n, 4, 2) + em <- "target_queue_size(): output vector length != input vector length." + expect_length(average_wait(in1, in2), length(in1)) +}) + + diff --git a/tests/testthat/test-queue_load.R b/tests/testthat/test-queue_load.R new file mode 100644 index 0000000..2f5473d --- /dev/null +++ b/tests/testthat/test-queue_load.R @@ -0,0 +1,54 @@ +# # Anticipated test from the error handling that Matt Dray is drafting +# test_that("function catches null values and reports error", { +# em <- "queue_load(): no error message when function is run with no inputs." +# expect_error(queue_load(), em) +# }) +# +# # Anticipated test from the error handling that Matt Dray is drafting +# test_that("function catches mismatched input lengths", { +# em <- "queue_load(): no error message when functions inputs are of different length." +# expect_error(queue_load(c(22,25,26), c(15, 20)), em) +# }) +# +# # Anticipated test from the error handling that Matt Dray is drafting +# test_that("it returns an error if either input aren't numeric", { +# in1 <- Sys.Date() +# in2 <- 27 +# +# em <- "queue_load(): all inputs must be numeric." +# expect_error(queue_load(in1, in2), em) +# }) + +test_that("it returns an expected result with fixed single values, against arithmetic", { + em <- "queue_load(): aritmetic error with single value inputs." + expect_equal(queue_load(30, 27), 30/27) +}) + +test_that("it returns an expected result with fixed single values", { + queue_load <- + em <- "queue_load(): aritmetic error with single value inputs." + expect_equal(queue_load(30, 27), 1.11111111) +}) + + +test_that("it returns an expected result with vector of fixed values", { + em <- "queue_load(): aritmetic error with vector of values as inputs." + expect_equal( + queue_load( + c(35, 30, 52), + c(27,25,42) + ) + , c( 1.2962963, 1.2, 1.23809524) + ) +}) + + +test_that("it returns the same length output as provided on input", { + n <- round(runif(1, 0,30)) + in1 <- rnorm(n = n, 50, 20) + in2 <- rnorm(n = n, 30, 5) + em <- "target_queue_size(): output vector length != input vector length." + expect_length(queue_load(in1, in2), length(in1)) +}) + + diff --git a/tests/testthat/test-relief_capacity.R b/tests/testthat/test-relief_capacity.R new file mode 100644 index 0000000..7a5b7a6 --- /dev/null +++ b/tests/testthat/test-relief_capacity.R @@ -0,0 +1,67 @@ +# # Anticipated test from the error handling that Matt Dray is drafting +# test_that("function catches null values and reports error", { +# em <- "relief_capacity(): no error message when function is run with no inputs." +# expect_error(relief_capacity(), em) +# }) +# +# # Anticipated test from the error handling that Matt Dray is drafting +# test_that("function catches mismatched input lengths", { +# em <- "relief_capacity(): no error message when functions inputs are of different length." +# expect_error( +# relief_capacity( +# c(30, 33, 35 ) +# , c(1200, 800, 250) +# , c(390,200) +# , c(26, 30, 15) +# ) +# , em) +# }) +# +# # Anticipated test from the error handling that Matt Dray is drafting +# test_that("it returns an error if either input aren't numeric", { +# in1 <- Sys.Date() +# in2 <- 1200 +# in3 <- 390 +# in4 <- 26 +# +# em <- "relief_capacity(): all inputs must be numeric." +# expect_error(relief_capacity(in1, in2, in3, in4), em) +# }) +#' + +test_that("it returns an expected result with fixed single values, against arithmetic", { + em <- "relief_capacity(): aritmetic error with single value inputs." + expect_equal(relief_capacity(30, 1200, 390, 26), 30 + (1200 - 390)/26) +}) + +test_that("it returns an expected result with fixed single values", { + em <- "relief_capacity(): aritmetic error with single value inputs." + expect_equal(relief_capacity(30, 1200, 390, 26), 61.153846) +}) + +test_that("it returns an expected result with vector of fixed values", { + em <- "relief_capacity(): aritmetic error with vector of input values." + expect_equal( + relief_capacity( + c(30, 33, 35 ), + c(1200, 800, 250), + c(390,200,100), + c(26, 30, 15) + ) + , c(61.153846, 53, 45) + ) +}) + + +test_that("it returns the same length output as provided on input", { + n <- round(runif(1, 0,30)) + in1 <- rnorm(n = n, 50, 20) + in2 <- in1 * (15 * runif(1,0 ,1.5)) + in3 <- in1 * (5 * runif(1,1 ,1.5)) + in4 <- in1 * (runif(1,0.5,1.5)) + + em <- "relief_capacity(): output vector length != input vector length." + expect_length(relief_capacity(in1, in2, in3, in4), length(in1)) +}) + + diff --git a/tests/testthat/test-target_capacity.R b/tests/testthat/test-target_capacity.R new file mode 100644 index 0000000..181b3e8 --- /dev/null +++ b/tests/testthat/test-target_capacity.R @@ -0,0 +1,53 @@ +# # Anticipated test from the error handling that Matt Dray is drafting +# test_that("function catches null values and reports error", { +# em <- "target_capacity(): no error message when function is run with no inputs." +# expect_error(target_capacity(), em) +# }) +# +# # Anticipated test from the error handling that Matt Dray is drafting +# test_that("function catches mismatched input lengths", { +# em <- "target_capacity(): no error message when functions inputs are of different length." +# expect_error(target_capacity(c(22,25,26), c(10, 12)), em) +# }) +# +# # Anticipated test from the error handling that Matt Dray is drafting +# test_that("it returns an error if either input aren't numeric", { +# in1 <- Sys.Date() +# in2 <- 1 +# +# em <- "target_capacity(): all inputs must be numeric." +# expect_error(target_capacity(in1, in2), em) +# }) + +test_that("it returns an expected result with fixed single values, against arithmetic", { + em <- "target_capacity(): aritmetic error with single value inputs." + expect_equal(target_capacity(30,52,3), 30 + 2*(1+4*3)/52) +}) + +test_that("it returns an expected result with fixed single values", { + em <- "target_capacity(): aritmetic error with single value inputs." + expect_equal(target_capacity(30,52,3), 30.5) +}) + +test_that("it returns an expected result with vector of fixed values", { + em <- "target_capacity(): aritmetic error with vector of input values." + expect_equal( + target_capacity( + c(30, 42, 35 ), + c(52, 65, 50), + c(3,2,1) + ) + , c(30.5, 42.276923, 35.2) + ) +}) + + +test_that("it returns the same length output as provided on input", { + n <- round(runif(1, 0,30)) + in1 <- rnorm(n = n, 50, 20) + in2 <- in1 * runif(1,0.5,1.5) + em <- "target_capacity(): output vector length != input vector length." + expect_length(target_capacity(in1, in2), length(in1)) +}) + + diff --git a/tests/testthat/test-target_queue_size.R b/tests/testthat/test-target_queue_size.R new file mode 100644 index 0000000..ebfc577 --- /dev/null +++ b/tests/testthat/test-target_queue_size.R @@ -0,0 +1,50 @@ +# # Anticipated test from the error handling that Matt Dray is drafting +# test_that("function catches null values and reports error", { +# em <- "target_queue_size(): no error message when function is run with no inputs." +# expect_error(target_queue_size(), em) +# }) +# +# # Anticipated test from the error handling that Matt Dray is drafting +# test_that("function catches mismatched input lengths", { +# em <- "target_queue_size(): no error message when functions inputs are of different length." +# expect_error(target_queue_size(c(22,25,26), c(10, 12)), em) +# }) +# # Anticipated test from the error handling that Matt Dray is drafting +# test_that("it returns an error if either input aren't numeric", { +# in1 <- Sys.Date() +# in2 <- 1 +# +# em <- "target_queue_size(): all inputs must be numeric." +# expect_error(target_queue_size(in1, in2), em) +# }) + + +test_that("it returns an expected result with fixed single values", { + em <- "target_queue_size(): aritmetic error with single value inputs." + expect_equal(target_queue_size(30, 52), 390) + expect_equal(target_queue_size(30, 50), 375) + expect_equal(target_queue_size(30, 50, 6), 250) +}) + +test_that("it returns an expected result with vector of fixed values", { + em <- "target_queue_size(): aritmetic error with vector of values as inputs." + expect_equal( + target_queue_size( + c(30, 30, 30 ), + c(52, 50, 50), + c(4,4,6) + ) + , c(390, 375, 250) + ) +}) + + +test_that("it returns the same length output as provided on input", { + n <- round(runif(1, 0,30)) + in1 <- rnorm(n = n, 50, 20) + in2 <- in1 * (1.2 + runif(1,0,1.5)) + em <- "target_queue_size(): output vector length != input vector length." + expect_length(target_queue_size(in1, in2), length(in1)) +}) + + diff --git a/tests/testthat/test-waiting_list_pressure.R b/tests/testthat/test-waiting_list_pressure.R new file mode 100644 index 0000000..ccf6675 --- /dev/null +++ b/tests/testthat/test-waiting_list_pressure.R @@ -0,0 +1,51 @@ +# # Anticipated test from the error handling that Matt Dray is drafting +# test_that("function catches null values and reports error", { +# em <- "waiting_list_pressure(): no error message when function is run with no inputs." +# expect_error(waiting_list_pressure(), em) +# }) +# +# # Anticipated test from the error handling that Matt Dray is drafting +# test_that("function catches mismatched input lengths", { +# em <- "waiting_list_pressure(): no error message when functions inputs are of different length." +# expect_error(waiting_list_pressure(c(22,25,26), c(10, 12)), em) +# }) +# # Anticipated test from the error handling that Matt Dray is drafting +# test_that("it returns an error if either input aren't numeric", { +# in1 <- Sys.Date() +# in2 <- 1 +# +# em <- "waiting_list_pressure(): all inputs must be numeric." +# expect_error(waiting_list_pressure(in1, in2), em) +# }) + +test_that("it returns an expected result with fixed single values, against arithmetic", { + em <- "waiting_list_pressure(): aritmetic error with single value inputs." + expect_equal(waiting_list_pressure(63, 52), 2 * 63 / 52) +}) + +test_that("it returns an expected result with fixed single values", { + em <- "waiting_list_pressure(): aritmetic error with single value inputs." + expect_equal(waiting_list_pressure(63, 52), 2.42307692) +}) + +test_that("it returns an expected result with vector of fixed values", { + em <- "waiting_list_pressure(): aritmetic error with vector of input values." + expect_equal( + waiting_list_pressure( + c(63, 42, 55 ), + c(52, 24, 50) + ) + , c(2.42307692, 3.5, 2.2) + ) +}) + + +test_that("it returns the same length output as provided on input", { + n <- round(runif(1, 0,30)) + in1 <- rnorm(n = n, 50, 20) + in2 <- in1 * (1.2 + runif(1,0,1.5)) + em <- "waiting_list_pressure(): output vector length != input vector length." + expect_length(waiting_list_pressure(in1, in2), length(in1)) +}) + +