Nothing
###############################################################################
## test.R ---
## Author : Samuel Noll
## Document created: 21/12/2017
## Last modified : ././2018 Descripiton
## : RF: 26/05/2019 adapt seed change
## : AC: 20/10/2022 adapt SD() and VAR() changes
###############################################################################
##Purpose: Test the trinROC package.
seedvalues <- if (R.version$minor<6 & R.version$major<4) c(.24,.537,1.163) else c(.25,.534,1.145)
# In this file we test all functions of trinROC.
# Each function is embedded in one context().
# Order is alphabetically
context("Test boot.test, trinVUS.test and trinROC.test:")
# generate test data:
n<-5
set.seed(1)
x1 <-rnorm(n)
y1 <-rnorm(n, mean=.3)
z1 <-rnorm(n, mean=.6)
x2<-rnorm(n,mean=4,sd=1)
y2<-rnorm(n, mean=5,sd=1.5)
z2<-rnorm(n, mean=6,sd=2)
classes <- gl(3,n, labels = c("D-","D0","D+"))
# combine sampled data with cp (chance plane) and cs (complete separation) data:
dat <- data.frame(group=classes, FAC1=c(x1,y1,z1), FAC2=c(x2,y2,z2),
cp = as.numeric(c(1:5,1:5,1:5)),
cs = as.numeric(c(1:5,6:10,11:15)) )
test_that("boot.test() function", {
# test perfect discrimination (cs):
temp <- boot.test(dat = dat[,c(1,5)])
expect_equal(temp$p.value, 0)
# here emp.vus is tested:
expect_equal(unname(temp$estimate[1]), 1)
# test uniformative case (cp):
temp <- boot.test(dat = dat[,c(1,4)])
expect_equal(temp$p.value, 1)
expect_equal(unname(round(temp$estimate[1],3)), 0.167)
# test sampled data, single assessment:
temp <- boot.test(dat = dat[,1:2])
expect_equal(round(temp$p.value,2), seedvalues[1])
expect_equal(unname(round(temp$estimate[1],3)), 0.368)
# test sampled data, comparison of markers:
temp <- boot.test(dat = dat[,1:3])
expect_equal(round(temp$p.value,2), 0.59)
expect_equal(unname(round(temp$statistic,3)), seedvalues[2])
})
test_that("trinVUS.test() function", {
# test perfect discrimination (cs):
temp <- trinVUS.test(dat = dat[,c(1,5)])
expect_equal(round(temp$p.value,3), 0)
expect_equal(unname(round(temp$estimate[1],3)), 0.988)
# test uniformative case (cp):
temp <- trinVUS.test(dat = dat[,c(1,4)])
expect_equal(temp$p.value, 1)
expect_equal(unname(round(temp$estimate[1],3)), 0.167)
# test sampled data, single assessment:
temp <- trinVUS.test(dat = dat[,1:2])
expect_equal(round(temp$p.value,2), 0.3)
expect_equal(unname(round(temp$estimate[1],3)), 0.306)
# test sampled data, comparison of markers:
temp <- trinVUS.test(dat = dat[,1:3])
expect_equal(round(temp$p.value,2), 0.66)
expect_equal(unname(round(temp$statistic,3)), 0.445)
})
test_that("trinROC.test() function", {
# test perfect discrimination (cs):
temp <- trinROC.test(dat = dat[,c(1,5)])
expect_equal(round(temp$p.value,3), 0)
expect_equal(unname(round(temp$statistic,3)), 24.194)
# test uniformative case (cp):
temp <- trinROC.test(dat = dat[,c(1,4)])
expect_equal(temp$p.value, 1)
expect_equal(unname(round(temp$statistic,3)), 0)
# test sampled data, single assessment:
temp <- trinROC.test(dat = dat[,1:2])
expect_equal(round(temp$p.value,2), 0.07)
# check arbitrarily parameter A:
expect_equal(as.numeric(round(temp$estimate[2],3)), 0.696)
# test sampled data, comparison of markers:
temp <- trinROC.test(dat = dat[,1:3])
expect_equal(round(temp$p.value,2), 0.44)
# check arbitrarily parameter D2:
expect_equal(round(temp$estimate[2,5],3), 0.144)
})
context("Test EDA functions: roc.eda(), rocsurf.emp(), rocsurf.trin():")
test_that("roc.eda(), whole functionality", {
temp <- roc.eda(dat = dat[,1:2], plotVUS = FALSE)
expect_equal(unname(round(temp$statistic,3)), seedvalues[3])
expect_equal(unname(temp$VUS), 0.368)
expect_equal(unname(round(temp$dat.summary[1,3],3)), 0.86)
temp <- roc.eda(dat = dat[,1:2], type = "t", plotVUS = FALSE)
expect_equal(unname(round(temp$statistic,3)), c(8.690,1.041))
expect_equal(unname(round(temp$VUS,3)), 0.306)
expect_equal(unname(round(temp$dat.summary[1,3],3)), 0.86)
})
test_that("rocsurf.emp(), whole functionality", {
temp <- rocsurf.emp(x1, y1, z1, plot=FALSE)
expect_equal(temp$zVUS[1,], c(0,0,0,0,.2,.2,.4,.4,.4,.6,.8,.8,1,1,1,1))
temp <- rocsurf.emp(1:5, 1:5, 1:5, plot=FALSE)
expect_equal(temp$zVUS[1,], c(0,.2,.4,.6,.8,1))
})
test_that("rocsurf.trin(), whole functionality", {
temp <- rocsurf.trin(x1,y1,z1, plot=FALSE)
expect_equal(round(temp$zVUS[1,133],3), 0.904)
})
context("Test supplementory functions: emp.vus(), findmu(), boxcoxROC():")
test_that("emp.vus(), whole functionality", {
expect_true(suppressWarnings(is.na(emp.vus("a","v","c"))))
expect_error(emp.vus())
expect_error(emp.vus(x, y))
# generate test data:
n<-100
set.seed(1)
x<-rnorm(n); y<-rnorm(n, 0.4); z<-rnorm(n, .8)
classes1 <- gl(3,n, labels = c("D-","D0","D+"))
classes2 <- gl(3,n, labels = c("c","a","b"))
dat1 <- data.frame(group=classes1, FAC1=c(x,y,z))
dat2 <- data.frame(group=classes2, FAC1=c(x,y,z))
# compare output:
expect_equal(emp.vus(x,y,z), emp.vus(dat = dat1))
expect_equal(emp.vus(x,y,z), emp.vus(dat = dat2))
expect_equal(emp.vus(x,y,z), emp.vus(1,1,1, dat = dat1))
expect_error(emp.vus(x, y))
})
test_that("boxcoxROC(), whole functionality", {
temp <- boxcoxROC(x1,y1,z1, lambda2 = abs(min(c(x1,y1,z1)))+6,
lambda = seq(-2.01, 2.01, 0.02), eps = 0.03, verbose = F)
expect_equal(round(temp$xbc[1],3), 19,769)
expect_equal(round(temp$lambda,3), 1.87)
})
test_that("findmu(), whole functionality", {
temp <- findmu(mux = 2, sdx = 1, sdy = 2, sdz = 4, VUS = 0.5)
expect_equal(round(temp$Coeff,3), c(2,3.212,6.424, 0.5))
})
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.