tests/testthat/test_subsidiaryFunctions.R

In superb: Summary Plots with Adjusted Error Bars

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)
#})