context("Testing Winer and Mauchly statistical tests and Shrout & Fleiss ICC functions")
test_that("Testing Welch degree of freedom", {
dta <- data.frame(cbind(
DV.1 = c(3., 6., 2., 2., 5.),
DV.2 = c(4., 5., 4., 4., 3.),
DV.3 = c(2., 7., 7., 8., 6.),
DV.4 = c(6., 8., 4., 6., 5.),
grp = c(1., 1., 2., 2., 2.)
))
expect_equal( WelchDegreeOfFreedom(dta, "DV.1", "grp"), 1.8988764 )
})
test_that("Testing Winer test", {
dta <- data.frame(cbind(
col1 <- c(3., 6., 2., 2., 5.),
col2 <- c(4., 5., 4., 4., 3.),
col3 <- c(2., 7., 7., 8., 6.),
col4 <- c(6., 8., 4., 6., 5.)
))
expect_equal( WinerCompoundSymmetryTest(dta), 0.6733123 )
})
test_that("Testing Mauchly test", {
dta <- data.frame(cbind(
col1 <- c(3., 6., 2., 2., 5.),
col2 <- c(4., 5., 4., 4., 3.),
col3 <- c(2., 7., 7., 8., 6.),
col4 <- c(6., 8., 4., 6., 5.)
))
expect_equal( MauchlySphericityTest(dta), 0.5824426 )
})
test_that("Testing Shrout and Fleiss functions", {
dta <- data.frame(cbind(
clus <- c(1, 1, 1, 1, 2, 2, 2, 2, 3, 3, 3, 3),
col1 <- c(2, 4, 4, 6, 4, 5, 8, 8, 5, 8, 9, 9)
))
expect_equal( ShroutFleissICC1(dta, 1, 2), 0.434343434 )
expect_equal( ShroutFleissICC11(dta[, 1], dta[,2]), 0.434343434 )
dta2 <- data.frame(cbind(
clus <- c(1, 1, 1, 1, 2, 2, 2, 2, 3, 3, 3, 3),
col1 <- c(1, 3, 3, 5, 3, 4, 7, 7, 4, 7, 8, 8),
col1 <- c(2, 4, 4, 6, 4, 5, 8, 8, 5, 8, 9, 9),
col1 <- c(3, 5, 5, 7, 5, 6, 9, 9, 6, 9, 10, 10)
))
expect_equal( ShroutFleissICC1(dta2, 1, 2:4), 0.7543859649 )
expect_equal( ShroutFleissICC1k(dta2[, 1], dta2[,2:4]), 0.7543859649 )
})
context("Testing the plotting sub-functions")
test_that("Testing is.stat.function", {
expect_equal(superb:::is.stat.function("superbPlot.bar"), FALSE)
expect_equal(superb:::is.stat.function("mean"), TRUE)
})
test_that("Testing is.plot.function", {
expect_equal(superb:::is.superbPlot.function("adsff"), FALSE)
expect_equal(superb:::is.superbPlot.function("superbPlot"), FALSE)
expect_equal(superb:::is.superbPlot.function("superbPlot.bar"), TRUE)
expect_equal(superb:::is.superbPlot.function("superbPlot.line"), TRUE)
expect_equal(superb:::is.superbPlot.function("superbPlot.point"), TRUE)
expect_equal(superb:::is.superbPlot.function("superbPlot.pointjitter"), TRUE)
expect_equal(superb:::is.superbPlot.function("superbPlot.pointjitterviolin"), TRUE)
})
test_that("Testing the built-in plotting function", {
dta <- data.frame(
dose = cbind(c(0.5,0.5,1,1,2,2)),
supp = cbind(c("OJ","VC","OJ","VC","OJ","VC")),
center = cbind(c(13,8,22,17,26,26)),
lowerwidth = cbind(c(-1,-.5,-1.5,-1,-1,-2)),
upperwidth = cbind(c(+1,+.5,+1.5,+1,+1,+2))
)
tg <- ToothGrowth
tg$DV <- tg$len
p1 <- superbPlot.bar(dta, "dose",
"supp", ".~.", tg, list(color="black"), list(color="purple") )
p2 <- superbPlot.line(dta, "dose",
"supp", ".~.", tg, list(color="black"), list(color="purple") )
p3 <- superbPlot.point(dta, "dose",
"supp", ".~.", tg, list(), list() )
p4 <- superbPlot.pointjitter(dta, "dose",
"supp", ".~.", tg, list(color="black"), errorbarParams = list(color="purple") ) +
scale_y_continuous("mean ratings") + scale_color_hue(l=40, c=35)
p5 <- superbPlot.pointjitterviolin(dta, "dose",
"supp", ".~dose", tg, list(color="black"), errorbarParams = list(color="purple") ) +
scale_y_continuous("mean ratings") + scale_color_hue(l=40, c=35)
expect_error( print(p1), NA ) # ok switched to dodge2
expect_error( print(p2), NA )
expect_error( print(p3), NA )
expect_error( print(p4), NA )
expect_error( print(p5), NA )
# the newer plot layouts
p6 <- superbPlot.boxplot(dta, "dose", "supp", ".~.", tg, list(color="red") )
p7 <- superbPlot.lineBand(dta, "dose", "supp", ".~.", tg)
p8 <- superbPlot.raincloud(dta, "dose", "supp", ".~dose", tg)
p9 <- superbPlot.halfwidthline(dta, "dose", "supp", ".~.", tg)
expect_error( print(p6), NA )
expect_error( print(p7), NA )
expect_error( print(p8), NA )
expect_error( print(p9), NA )
})
#test_that("Testing the runDebug functions", {
# expect_equal( getOption("superb.feedback"), c("design","warnings","summary") )
# expect_equal( runDebug("design","THIS IS A TEST OF runDebug",c(),list()), NULL)
#})
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.