Nothing
context("calculateAllT")
################################################################################
# CHANGE LOG
# 04.07.2023: Updated expected Hosmer-Lemeshow_p values due to a change in
# the ResourceSelection package 0.3-6, which involves changes to the Hosmer-Lemeshov
# test because the test degrees of freedom was incorrectly determined for
# certain small data sets.
# 14.03.2019: Added temporary fix for changed random number generator.
# 13.07.2018: First version.
#
# require(strvalidator)
# require(testthat)
# NB! ResourceSelection is required for this test function.
# require(ResourceSelection)
# test_dir("inst/tests/")
# test_file("tests/testthat/test-calculateAllT.r")
# test_dir("tests/testthat")
test_that("calculateAllT", {
# Get test data.
data(set4)
data(ref4)
# Score dropout.
kit <- "ESX17"
# The default method for generating from a discrete uniform distribution
# (used in sample(), for instance) has been changed.
# The previous method can be requested using RNGkind() or
# RNGversion() if necessary for reproduction of old results.
RNGversion("3.5.0")
# suppressWarnings(RNGversion("3.5.0"))
# before calling set.seed() in your example, vignette and test code
# (where the difference in RNG sample kinds matters, of course).
# Note that this ensures using the (old) non-uniform "Rounding" sampler
# for all 3.x versions of R, and does not add an R version dependency.
# Note also that the new "Rejection" sampler which R will use from 3.6.0
set.seed(123) # Set random seed for reproducible result on method X.
dropout <- suppressMessages(calculateDropout(
data = set4, ref = ref4, kit = kit,
ignore.case = TRUE
))
# Calculate average peak height.
dfH <- suppressMessages(calculateHeight(
data = set4, ref = ref4, na.replace = 0,
add = FALSE, exclude = "OL", sex.rm = TRUE,
qs.rm = TRUE, kit = kit,
ignore.case = TRUE, exact = FALSE
))
# Add average peak height to dataset.
dropout <- suppressMessages(addData(
data = dropout, new.data = dfH,
by.col = "Sample.Name", then.by.col = NULL,
exact = TRUE, ignore.case = TRUE
))
# TEST 01 -------------------------------------------------------------------
# Test that the expected result is calculated.
# Analyse dataframe.
res <- suppressMessages(
calculateAllT(
data = dropout, kit = kit,
p.dropout = 0.01, p.conservative = 0.05
)
)
# Check return class.
expect_match(class(res), class(data.frame()))
# Check that expected Explanatory_variable was recorded.
expect_equal(res[1, 1], "Random (Ph)")
expect_equal(res[2, 1], "LMW (Ph)")
expect_equal(res[3, 1], "HMW (Ph)")
expect_equal(res[4, 1], "Locus (Ph)")
expect_equal(res[5, 1], "Random (H)")
expect_equal(res[6, 1], "LMW (H)")
expect_equal(res[7, 1], "HMW (H)")
expect_equal(res[8, 1], "Locus (H)")
expect_equal(res[9, 1], "Random log(Ph)")
expect_equal(res[10, 1], "LMW log(Ph)")
expect_equal(res[11, 1], "HMW log(Ph)")
expect_equal(res[12, 1], "Locus log(Ph)")
expect_equal(res[13, 1], "Random log(H)")
expect_equal(res[14, 1], "LMW log(H)")
expect_equal(res[15, 1], "HMW log(H)")
expect_equal(res[16, 1], "Locus log(H)")
# Check that expected P(dropout)=0.01@T was calculated.
expect_equal(res[1, 2], 611)
expect_equal(res[2, 2], 495)
expect_equal(res[3, 2], 784)
expect_equal(res[4, 2], 646)
expect_equal(res[5, 2], 531)
expect_equal(res[6, 2], 517)
expect_equal(res[7, 2], 513)
expect_equal(res[8, 2], 533)
expect_equal(res[9, 2], 883)
expect_equal(res[10, 2], 627)
expect_equal(res[11, 2], 1080)
expect_equal(res[12, 2], 897)
expect_equal(res[13, 2], 744)
expect_equal(res[14, 2], 696)
expect_equal(res[15, 2], 672)
expect_equal(res[16, 2], 766)
# Check that expected P(dropout>0.01)<0.05@T was calculated.
expect_equal(res[1, 3], 1112)
expect_equal(res[2, 3], 811)
expect_equal(res[3, 3], 1514)
expect_equal(res[4, 3], 901)
expect_equal(res[5, 3], 779)
expect_equal(res[6, 3], 767)
expect_equal(res[7, 3], 777)
expect_equal(res[8, 3], 678)
expect_equal(res[9, 3], 2345)
expect_equal(res[10, 3], 1378)
expect_equal(res[11, 3], 3423)
expect_equal(res[12, 3], 1597)
expect_equal(res[13, 3], 1467)
expect_equal(res[14, 3], 1381)
expect_equal(res[15, 3], 1358)
expect_equal(res[16, 3], 1194)
# Check that expected Hosmer-Lemeshow_p was calculated.
expect_equal(res[1, 4], 0.6668)
expect_equal(res[2, 4], 0.9574)
expect_equal(res[3, 4], 0.9973)
expect_equal(res[4, 4], 0.9501)
expect_equal(res[5, 4], 0.9987)
expect_equal(res[6, 4], 0.9546)
expect_equal(res[7, 4], 0.9895)
expect_equal(res[8, 4], 0.9752)
expect_equal(res[9, 4], 0.3480)
expect_equal(res[10, 4], 0.8312)
expect_equal(res[11, 4], 0.8982)
expect_equal(res[12, 4], 0.8022)
expect_equal(res[13, 4], 0.9871)
expect_equal(res[14, 4], 0.9245)
expect_equal(res[15, 4], 0.9650)
expect_equal(res[16, 4], 0.8995)
# Check that expected beta0 was calculated.
expect_equal(res[1, 5], -0.3754)
expect_equal(res[2, 5], 0.2337)
expect_equal(res[3, 5], -0.9888)
expect_equal(res[4, 5], 0.9789)
expect_equal(res[5, 5], 0.7768)
expect_equal(res[6, 5], 0.7341)
expect_equal(res[7, 5], 0.6129)
expect_equal(res[8, 5], 2.4478)
expect_equal(res[9, 5], 6.9153)
expect_equal(res[10, 5], 9.6917)
expect_equal(res[11, 5], 5.2677)
expect_equal(res[12, 5], 11.5748)
expect_equal(res[13, 5], 10.6388)
expect_equal(res[14, 5], 10.8486)
expect_equal(res[15, 5], 10.7495)
expect_equal(res[16, 5], 15.5977)
# Check that expected beta1 was calculated.
expect_equal(res[1, 6], -0.0069)
expect_equal(res[2, 6], -0.0097)
expect_equal(res[3, 6], -0.0046)
expect_equal(res[4, 6], -0.0086)
expect_equal(res[5, 6], -0.0101)
expect_equal(res[6, 6], -0.0103)
expect_equal(res[7, 6], -0.0102)
expect_equal(res[8, 6], -0.0132)
expect_equal(res[9, 6], -1.6970)
expect_equal(res[10, 6], -2.2182)
expect_equal(res[11, 6], -1.4120)
expect_equal(res[12, 6], -2.3783)
expect_equal(res[13, 6], -2.3039)
expect_equal(res[14, 6], -2.3593)
expect_equal(res[15, 6], -2.3572)
expect_equal(res[16, 6], -3.0403)
# Check that expected observed was calculated.
expect_equal(res[1, 7], 381)
expect_equal(res[2, 7], 382)
expect_equal(res[3, 7], 383)
expect_equal(res[4, 7], 367)
expect_equal(res[5, 7], 381)
expect_equal(res[6, 7], 382)
expect_equal(res[7, 7], 383)
expect_equal(res[8, 7], 367)
expect_equal(res[9, 7], 381)
expect_equal(res[10, 7], 382)
expect_equal(res[11, 7], 383)
expect_equal(res[12, 7], 367)
expect_equal(res[13, 7], 381)
expect_equal(res[14, 7], 382)
expect_equal(res[15, 7], 383)
expect_equal(res[16, 7], 367)
# Check that expected dropout was calculated.
expect_equal(res[1, 8], 17)
expect_equal(res[2, 8], 16)
expect_equal(res[3, 8], 15)
expect_equal(res[4, 8], 31)
expect_equal(res[5, 8], 17)
expect_equal(res[6, 8], 16)
expect_equal(res[7, 8], 15)
expect_equal(res[8, 8], 31)
expect_equal(res[9, 8], 17)
expect_equal(res[10, 8], 16)
expect_equal(res[11, 8], 15)
expect_equal(res[12, 8], 31)
expect_equal(res[13, 8], 17)
expect_equal(res[14, 8], 16)
expect_equal(res[15, 8], 15)
expect_equal(res[16, 8], 31)
# TEST 02 -------------------------------------------------------------------
# Test that input data is checked.
# Dataframe with required column names.
dfNames <- data.frame(MethodX = NA, Method1 = NA, Method2 = NA, MethodL = NA, Height = NA, H = NA, MethodL.Ph = NA)
# Missing 'MethodX' column should generate an error.
expect_error(calculateAllT(
data = dfNames[, -1], kit = kit,
p.dropout = 0.01, p.conservative = 0.05
))
# Missing 'Method1' column should generate an error.
expect_error(calculateAllT(
data = dfNames[, -2], kit = kit,
p.dropout = 0.01, p.conservative = 0.05
))
# Missing 'Method2' column should generate an error.
expect_error(calculateAllT(
data = dfNames[, -3], kit = kit,
p.dropout = 0.01, p.conservative = 0.05
))
# Missing 'MethodL' column should generate an error.
expect_error(calculateAllT(
data = dfNames[, -4], kit = kit,
p.dropout = 0.01, p.conservative = 0.05
))
# Missing 'Height' column should generate an error.
expect_error(calculateAllT(
data = dfNames[, -5], kit = kit,
p.dropout = 0.01, p.conservative = 0.05
))
# Missing 'H' column should generate an error.
expect_error(calculateAllT(
data = dfNames[, -6], kit = kit,
p.dropout = 0.01, p.conservative = 0.05
))
# Missing 'MethodL.Ph' column should generate an error.
expect_error(calculateAllT(
data = dfNames[, -7], kit = kit,
p.dropout = 0.01, p.conservative = 0.05
))
# kit not in kit definition file should generate an error.
expect_error(calculateAllT(
data = dropout, kit = "KitNotDefined",
p.dropout = 0.01, p.conservative = 0.05
))
# p.dropout > 1 should generate an error.
expect_error(calculateAllT(
data = dropout, kit = kit,
p.dropout = 1.01, p.conservative = 0.05
))
# p.dropout < 0 should generate an error.
expect_error(calculateAllT(
data = dropout, kit = kit,
p.dropout = -0.01, p.conservative = 0.05
))
# length(p.dropout) > 1 should generate an error.
expect_error(calculateAllT(
data = dropout, kit = kit,
p.dropout = c(0.01, 0.01), p.conservative = 0.05
))
# p.conservative > 1 should generate an error.
expect_error(calculateAllT(
data = dropout, kit = kit,
p.dropout = 0.01, p.conservative = 1.05
))
# p.conservative < 0 should generate an error.
expect_error(calculateAllT(
data = dropout, kit = kit,
p.dropout = 0.01, p.conservative = -0.05
))
# length(p.conservative) > 1 should generate an error.
expect_error(calculateAllT(
data = dropout, kit = kit,
p.dropout = 0.01, p.conservative = c(0.05, 0.05)
))
})
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.