tests/testthat/test_superbPlot.R

context("Testing suberbPlot")


test_that("PRELIMINARY TESTS (1/4)", {
	old <- options() 
	on.exit(options(old)) 
	options("superb.feedback" = 'none')
	
    library(grid)
    library(gridExtra)

    # files are exported for validation with Mathematica's MeanPlot
    # write.table(ToothGrowth, file = "file0.dat", sep = "\t", col.names = FALSE)

    plt <- superbPlot(ToothGrowth, BSFactor = c("dose","supp"), variables = "len",
      statistic = "mean", plotStyle="bar" )

    expect_equal( "ggplot" %in% class(plt), TRUE)
    # restores default information
    options("superb.feedback" = c('design','warnings','summary'))
})


test_that("PRELIMINARY TESTS (2/4)", {
	old <- options() 
	on.exit(options(old)) 
	options("superb.feedback" = 'none')

    library(grid)
    g0 <- superbPlot(ToothGrowth, BSFactor = c("dose","supp"), variables = "len",
      statistic = "mean", 
      adjustments = list(purpose = "difference"), plotStyle="bar"
    ) 
    g1 <- g0 + xlab("Dose") + ylab("Tooth Growth") + labs(title="adsf") +
    theme_light(base_size=20) + annotation_custom(grid.text("allo",x=.5,y=.5,gp=gpar(fontsize=20, col="grey")))
    g2 <- g1 + theme(axis.text.x = element_text(size=30, colour="red") ) + coord_cartesian(ylim=c(5,45))

    expect_equal( "ggplot" %in% class(g2), TRUE)
    # restores default information
    options("superb.feedback" = c('design','warnings','summary'))
})

test_that("PRELIMINARY TESTS (3/4)", {
	old <- options() 
	on.exit(options(old)) 
	options("superb.feedback" = 'none')

    res <- superbPlot(ToothGrowth, BSFactor = c("dose","supp"), 
      variables = "len", showPlot=FALSE )

    expect_output( str(res), "data.frame")
    # restores default information
    options("superb.feedback" = c('design','warnings','summary'))
})

test_that("PRELIMINARY TESTS (4/4)", {
	old <- options() 
	on.exit(options(old)) 
	options("superb.feedback" = 'none')

    p <- superbPlot(ToothGrowth, BSFactor = c("dose","supp"), variables = "len",
      statistic = "mean", plotStyle="line" )

    expect_equal( "ggplot" %in% class(p), TRUE)
    # restores default information
    options("superb.feedback" = c('design','warnings','summary'))
})




#########################################
# SYSTEMATIC TESTS OF THE STATISTICS
#########################################

test_that("test 1a: 3 groupes inpependants", { 
	old <- options() 
	on.exit(options(old)) 
	options("superb.feedback" = 'none')

    dta1a <- GRD( SubjectsPerGroup = 20, BSFactors = "Group(3)", Population = list( mean=10, stddev = 5) )
    # write.table(dta1a, file = "test1a.dat", sep = "\t", col.names = FALSE)
    p <- superbPlot(dta1a, BSFactor = "Group", variables = "DV",
      statistic = "mean", errorbar = "SE", plotStyle="line")

    expect_equal( "ggplot" %in% class(p), TRUE)
    # restores default information
    options("superb.feedback" = c('design','warnings','summary'))
})


test_that("test 1b: factorielle a grps independants; 3 x 2", {
	old <- options() 
	on.exit(options(old)) 
	options("superb.feedback" = 'none')

    dta1b <- GRD( SubjectsPerGroup = 20, BSFactors = "Group(3): Sex(2)", Population = list( mean=10, stddev = 5))
    # write.table(dta1b, file = "test1b.dat", sep = "\t", col.names = FALSE)
    p <- superbPlot(dta1b, BSFactor = c("Group","Sex"), variables = "DV",
      statistic = "mean", errorbar = "SE" )

    expect_equal( "ggplot" %in% class(p), TRUE)
    # restores default information
    options("superb.feedback" = c('design','warnings','summary'))
})


test_that("test 2a: 1 facteur a 3 mesures repetees; (3)", {
	old <- options() 
	on.exit(options(old)) 
	options("superb.feedback" = 'warnings')

    dta2a <- GRD( WSFactors = "Moment(3)", SubjectsPerGroup = 5, Population = list( mean=10, stddev = 5))
    # write.table(dta2a, file = "test2a.dat", sep = "\t", col.names = FALSE)
    expect_message( p <- superbPlot(dta2a, WSFactor = "moment(3)", 
      adjustments=list(decorrelation="CA"),
      errorbar = "CI", plotStyle="line",
      variables = c("DV.1","DV.2","DV.3") 
    ))

    expect_equal( "ggplot" %in% class(p), TRUE)
    # restores default information
    options("superb.feedback" = c('design','warnings','summary'))
})


test_that("test 2b: 2 facteurs a mesures repetees; (3 x 2)", {
	old <- options() 
	on.exit(options(old)) 
	options("superb.feedback" = 'none')

    dta2b <- GRD( WSFactors = "Moment(3): Dose(2)", SubjectsPerGroup = 5, Population = list( mean=10, stddev = 5, rho = .80))
    # write.table(dta2b, file = "test2b.dat", sep = "\t", col.names = FALSE)
    p <- superbPlot(dta2b, WSFactor = c("moment(3)","Dose(2)"), 
      variables = c("DV.1.1","DV.2.1","DV.3.1","DV.1.2","DV.2.2","DV.3.2"), 
      statistic="mean", errorbar = "CI", gamma = 0.90, plotStyle = "line",
      adjustments = list(purpose="difference", decorrelation="CM"),
      errorbarParams = list(position = position_dodge(width = .15)),
      pointParams = list(position = position_dodge(width = .15)),
    )

    expect_equal( "ggplot" %in% class(p), TRUE)
    options("superb.feedback" = c("design","warnings") ) # restores to default
})


test_that("test 3: scheme mixte; 3 x (3)", {
	old <- options() 
	on.exit(options(old)) 
	options("superb.feedback" = 'warnings')

    dta3 <- GRD( BSFactors = "Group(3)", WSFactors = "Moment(3)", 
      SubjectsPerGroup = 5, Population = list( mean=10, stddev = 5),
      Effects = list("Moment" = slope(5))
    )
    # write.table(dta3, file = "test3.dat", sep = "\t", col.names = FALSE)
    expect_message( p <- superbPlot(dta3, WSFactor = "Moment(3)", BSFactor = "Group", 
        variables = c("DV.1","DV.2","DV.3"), 
        statistic = "mean", errorbar = "SE", plotStyle="line",
        adjustments = list(purpose="single", decorrelation="CM")
    ))

    expect_equal( "ggplot" %in% class(p), TRUE)
    # restores default information
    options("superb.feedback" = c('design','warnings','summary'))
})


test_that("test 4a: scheme a trois facteurs, 2 etant between  3 x 3 x (3)", {
	old <- options() 
	on.exit(options(old)) 
	options("superb.feedback" = 'none')

    dta4a <- GRD( BSFactors = "Group(3) : Dose(3)", WSFactors = "Moment(3)", 
      SubjectsPerGroup = 4, Population = list( mean=10, stddev = 5),
      Effects = list("Moment" = slope(5))
    )
    # write.table(dta4a, file = "test4a.dat", sep = "\t", col.names = FALSE)
    p <- superbPlot(dta4a, BSFactor = c("Group","Dose"), WSFactor = "Moment(3)", 
      variables = c("DV.1","DV.2","DV.3"), plotStyle = "line",
      statistic = "mean", errorbar = "SE",
      adjustments = list(purpose="difference", decorrelation="none"),
      factorOrder = c("Dose","Group","Moment"), showPlot = T)

    expect_equal( "ggplot" %in% class(p), TRUE)
    # restores default information
    options("superb.feedback" = c('design','warnings','summary'))
})
    
  
test_that("test 5a: scheme a quatre facteurs; 5 x 4 (3 x 2)", {
	old <- options() 
	on.exit(options(old)) 
	options("superb.feedback" = 'none')

    dta5a <- GRD( SubjectsPerGroup = 20, BSFactors = "Group(5) : Dose(4)", WSFactors = "Moment(3):Hand(2)", 
        Population = list( mean=10, stddev = 5, rho = .90),
        Effects = list("Moment" = slope(5), "Hand" = slope(10)) )
    # write.table(dta5a, file = "test5a.dat", sep = "\t", col.names = FALSE)
    p <- superbPlot(dta5a, plotStyle="line",
        WSFactor = c("Moment(3)","Hand(2)"), 
        BSFactor= c("Group","Dose"),
        variables = c("DV.1.1","DV.2.1","DV.3.1","DV.1.2","DV.2.2","DV.3.2"), 
        statistic = "mean", errorbar = "CI", gamma = .9999,
        adjustments = list(purpose="difference", decorrelation="CM")
    )

    expect_equal( "ggplot" %in% class(p), TRUE)
    options("superb.feedback" = c("design","warnings") ) # restores to default
})


#########################################
# SYSTEMATIC TESTS OF THE OPTIONS
#########################################

test_that("test 6: Some data", {
	old <- options() 
	on.exit(options(old)) 
	options("superb.feedback" = 'none')

    dta6 <- GRD( WSFactors = "Moment(3):Hand(2)",
        Effects = list("Moment" = slope(5), "Hand" = slope(3)),
        SubjectsPerGroup = 6,
        Population = list (mean = 20, stddev = 5, rho = 0.8) )

    expect_output( str(dta6), "data.frame")
    # restores default information
    options("superb.feedback" = c('design','warnings','summary'))
})


test_that("test 6a: factorOrder", {
	old <- options() 
	on.exit(options(old)) 
	options("superb.feedback" = 'none')

    library(gridExtra)
    dta6 <- GRD( WSFactors = "Moment(3):Hand(2)",
        Effects = list("Moment" = slope(5), "Hand" = slope(3)),
        SubjectsPerGroup = 6,
        Population = list (mean = 20, stddev = 5, rho = 0.8) )
    # factorOrder
    p1 <- superbPlot(dta6, 
        WSFactor = c("Moment(3)","Hand(2)"),  
        variables = c("DV.1.1","DV.2.1","DV.3.1","DV.1.2","DV.2.2","DV.3.2"), 
        statistic = "mean", errorbar = "SE", factorOrder = c("Moment", "Hand") )
    p2 <- superbPlot(dta6, 
        WSFactor = c("Moment(3)","Hand(2)"),  
        variables = c("DV.1.1","DV.2.1","DV.3.1","DV.1.2","DV.2.2","DV.3.2"), 
        statistic = "mean", errorbar = "SE", factorOrder = c("Hand","Moment") )
    p <- grid.arrange(p1,p2,ncol=2)

    expect_equal( "ggplot" %in% class(p1), TRUE)
    expect_equal( "ggplot" %in% class(p2), TRUE)
    # restores default information
    options("superb.feedback" = c('design','warnings','summary'))
})


test_that("test 6b: adjustments CA vs CM vs LM vs UA", {
	old <- options() 
	on.exit(options(old)) 
	options("superb.feedback" = 'none')

    library(gridExtra)
    dta6 <- GRD( WSFactors = "Moment(3):Hand(2)", 
        Effects = list("Moment" = slope(5), "Hand" = slope(3)),
        SubjectsPerGroup = 6,
        Population = list (mean = 20, stddev = 5, rho = 0.8) )
    # adjustments CA vs CM vs LM vs UA
    p1 <- superbPlot(dta6, 
        WSFactor = c("Moment(3)","Hand(2)"),  
        variables = c("DV.1.1","DV.2.1","DV.3.1","DV.1.2","DV.2.2","DV.3.2"), 
        adjustments = list(purpose="difference", decorrelation="CA") )+
      coord_cartesian( ylim = c(8,30) ) + labs(title="CA") 
    p2 <- superbPlot(dta6, 
        WSFactor = c("Moment(3)","Hand(2)"),  
        variables = c("DV.1.1","DV.2.1","DV.3.1","DV.1.2","DV.2.2","DV.3.2"), 
        adjustments = list(purpose="difference", decorrelation="CM") )+
      coord_cartesian( ylim = c(8,30) ) + labs(title="CM") 
    p3 <- superbPlot(dta6, 
        WSFactor = c("Moment(3)","Hand(2)"),  
        variables = c("DV.1.1","DV.2.1","DV.3.1","DV.1.2","DV.2.2","DV.3.2"), 
        adjustments = list(purpose="difference", decorrelation="LM") )+
      coord_cartesian( ylim = c(8,30) ) + labs(title="LM") 
    p4 <- superbPlot(dta6, 
        WSFactor = c("Moment(3)","Hand(2)"),  
        variables = c("DV.1.1","DV.2.1","DV.3.1","DV.1.2","DV.2.2","DV.3.2"), 
        adjustments = list(purpose="difference", decorrelation="UA") )+
      coord_cartesian( ylim = c(8,30) ) + labs(title="UA") 
    p <- grid.arrange(p1,p2,p3,p4,ncol=4)

    expect_equal( "ggplot" %in% class(p1), TRUE)
    expect_equal( "ggplot" %in% class(p2), TRUE)
    expect_equal( "ggplot" %in% class(p3), TRUE)
    expect_equal( "ggplot" %in% class(p4), TRUE)
    # restores default information
    options("superb.feedback" = c('design','warnings','summary'))
})


test_that("test 6c: statistics of central tendency mean, median and gmean", {
	old <- options() 
	on.exit(options(old)) 
	options("superb.feedback" = 'none')

    library(gridExtra)
    dta6 <- GRD( WSFactors = "Moment(3):Hand(2)",  
        Effects = list("Moment" = slope(5), "Hand" = slope(3)),
        SubjectsPerGroup = 6,
        Population = list (mean = 20, stddev = 1, rho = 0.8) )
    p1 <- superbPlot(dta6, 
        WSFactor = c("Moment(3)","Hand(2)"),  
        variables = c("DV.1.1","DV.2.1","DV.3.1","DV.1.2","DV.2.2","DV.3.2"), 
        statistic = "mean", errorbar = "CI"  ) +
      coord_cartesian( ylim = c(8,30) ) + labs(title="mean") 
    p2 <- superbPlot(dta6, 
        WSFactor = c("Moment(3)","Hand(2)"),  
        variables = c("DV.1.1","DV.2.1","DV.3.1","DV.1.2","DV.2.2","DV.3.2"), 
        statistic = "median", errorbar = "CI"  ) +
      coord_cartesian( ylim = c(8,30) ) + labs(title="median") 
    p3 <- superbPlot(dta6, 
        WSFactor = c("Moment(3)","Hand(2)"),  
        variables = c("DV.1.1","DV.2.1","DV.3.1","DV.1.2","DV.2.2","DV.3.2"), 
        statistic = "gmean", errorbar = "CI"  ) +
      coord_cartesian( ylim = c(8,30) ) + labs(title="geometric mean")
    p <- grid.arrange(p1,p2,p3,ncol=3)

    expect_equal( "ggplot" %in% class(p1), TRUE)
    expect_equal( "ggplot" %in% class(p2), TRUE)
    expect_equal( "ggplot" %in% class(p3), TRUE)
    # restores default information
    options("superb.feedback" = c('design','warnings','summary'))
})


test_that("test 6d: statistics of dispersion sd and MAD", {
	old <- options() 
	on.exit(options(old)) 
    options("superb.feedback" = "none") # to supress design confirmation; unneeded in tests

    library(gridExtra)
    dta6 <- GRD( WSFactors = "Moment(3):Hand(2)",  
        Effects = list("Moment" = slope(5), "Hand" = slope(3)),
        SubjectsPerGroup = 6,
        Population = list (mean = 20, stddev = 5, rho = 0.8) )    # functions; SD should be asymmetrical; fisherskew should be about 0
    # fisherkurtosis is less stable; MAD should be about 2.5;
    # gmean requires only positive data;
    p1 <- superbPlot(dta6, 
        WSFactor = c("Moment(3)","Hand(2)"),  
        variables = c("DV.1.1","DV.2.1","DV.3.1","DV.1.2","DV.2.2","DV.3.2"), 
        statistic = "sd", errorbar = "CI"  )
    p2 <- superbPlot(dta6, 
        WSFactor = c("Moment(3)","Hand(2)"),  
        variables = c("DV.1.1","DV.2.1","DV.3.1","DV.1.2","DV.2.2","DV.3.2"), 
        statistic = "MAD", errorbar = "CI"  )
    p <- grid.arrange(p1,p2,ncol=2)

    expect_equal( "ggplot" %in% class(p1), TRUE)
    expect_equal( "ggplot" %in% class(p2), TRUE)
    # restores default information
    options("superb.feedback" = c('design','warnings','summary'))
})



test_that("test 6e: adding ggplot graphics directives", {
	old <- options() 
	on.exit(options(old)) 
	options("superb.feedback" = 'none')

    # ggplot arguments
    p1 <- superbPlot(ToothGrowth, BSFactor = c("dose","supp"), variables = "len",
      statistic = "mean", errorbar = "CI", gamma = .999,
      adjustments = list(purpose = "difference") )
    p2 <- p1 + 
      # all these are added to the plot
      xlab("Dose per day") + ylab("Tooth Growth after study") + 
      theme_light(base_size=14 )

    expect_equal( "ggplot" %in% class(p2), TRUE)
    # restores default information
    options("superb.feedback" = c('design','warnings','summary'))
})

      
test_that("test 6f: adding ggplot arguments to the error bars, to the points", {
	old <- options() 
	on.exit(options(old)) 
	options("superb.feedback" = 'none')

    p <- superbPlot(ToothGrowth, BSFactor = c("dose","supp"), variables = "len",
      statistic = "mean", errorbar = "CI", gamma = .999,
      adjustments = list(purpose = "difference"),
      # see geom_errorbar for the possible arguments
      errorbarParams = list(width = .8, linewidth = 3, colour = "gray"),
      # see geom_point or geom_bar for possible arguments
      barParams = list(linetype = 3, colour = "black", linewidth = .5)  
    )

    expect_equal( "ggplot" %in% class(p), TRUE)
    # restores default information
    options("superb.feedback" = c('design','warnings','summary'))
})


test_that("test 6g: adding ggplot arguments to the error bars, to the points (bis)", {
	old <- options() 
	on.exit(options(old)) 
	options("superb.feedback" = 'none')

    p <- superbPlot(ToothGrowth, BSFactor = c("dose","supp"), variables = "len",
      statistic = "mean", errorbar = "CI", gamma = .999,
      adjustments = list(purpose = "difference"),
      plotStyle = "line",
      # see geom_errorbar for the possible arguments
      errorbarParams = list(width = .02, linewidth = 0.1, colour = "gray"),
      # see geom_point or geom_bar for possible arguments
      pointParams = list(colour = "gray", size = 10.5)  
    )

    expect_equal( "ggplot" %in% class(p), TRUE)
    # restores default information
    options("superb.feedback" = c('design','warnings','summary'))
})


#########################################
# TESTS WITH ICC
#########################################

test_that("Explorations for ICC", {
	old <- options() 
	on.exit(options(old)) 
    options("superb.feedback" = c('warnings'))

    library(gridExtra)
    dta99 <- GRD( WSFactors = "Moment(3)", SubjectsPerGroup = 15, 
        Population = list( mean=20, stddev = 5),
        Effects = list("Moment" = slope(3) ) )
    # add cluster information at the end
    dta99$myclus <- sort(rep(1:5, 3))
    # create some intraclass correlation artificially
    dta99$DV.1 <- dta99$DV.1 + 10 * dta99$myclus
    dta99$DV.2 <- dta99$DV.2 + 10 * dta99$myclus
    dta99$DV.3 <- dta99$DV.3 + 10 * dta99$myclus

    # write.table(dta99, file = 'file9.dat', sep = "\t", col.names = FALSE)

    expect_message( noncluster <- superbPlot(dta99, WSFactor = "moment(3)", 
      adjustments = list(decorrelation="CM"),
      errorbar = "CI", showPlot=TRUE,
      variables = c("DV.1","DV.2","DV.3") 
    )+ labs(title="Without cluster information") + coord_cartesian( ylim = c(40,60) ) )
    expect_message( yescluster <- superbPlot(dta99, WSFactor = "moment(3)", 
      adjustments = list(decorrelation="CM", samplingDesign = "CRS"),
      clusterColumn = "myclus",
      errorbar = "CI", showPlot=TRUE,
      variables = c("DV.1","DV.2","DV.3") 
    )+ labs(title="with cluster information") + coord_cartesian( ylim = c(40,60) ) )
    p <- grid.arrange(noncluster, yescluster, ncol=2)

    expect_equal( "ggplot" %in% class(noncluster), TRUE)
    expect_equal( "ggplot" %in% class(yescluster), TRUE)
    # restores default information
    options("superb.feedback" = c('design','warnings','summary'))
})



########################################################
# latest tests based on dta3 verifying CM and popSize  #
########################################################

test_that("Verifying CM and popSize ", {
	old <- options() 
	on.exit(options(old)) 
    options("superb.feedback" = c('warnings'))

    library(gridExtra)
    dta3 <- GRD( BSFactors = "Group(2)", WSFactors = "Moment(3)", 
      SubjectsPerGroup = 5, Population = list (mean = 20, stddev = 5, rho = 0.8),
      Effects = list("Moment" = slope(5)) )
    # write.table(dta3, file = "file3.dat", sep = "\t", col.names = FALSE)

    expect_message( p1 <- superbPlot(dta3, WSFactor = "Moment(3)", BSFactor = "Group", 
        variables = c("DV.1","DV.2","DV.3"), 
        statistic = "mean", errorbar = "SE",
        adjustments = list(purpose="single", decorrelation="CM", popSize = Inf )
      ) + labs(title="Infinite populations") )
    expect_message( p2 <- superbPlot(dta3, WSFactor = "Moment(3)", BSFactor = "Group", 
        variables = c("DV.1","DV.2","DV.3"), 
        statistic = "mean", errorbar = "SE",
        adjustments = list(purpose="single", decorrelation="CM", popSize = c(Inf,6) )
      ) + labs(title="population of 6 in grp 2") )
    p <- grid.arrange(p1,p2,ncol=2)

    expect_equal( "ggplot" %in% class(p1), TRUE)
    expect_equal( "ggplot" %in% class(p2), TRUE)
    # restores default information
    options("superb.feedback" = c('design','warnings','summary'))
})


#########################################
# testing pre and post processing: OK!
#########################################

test_that("Testing pre and post processing", {
	old <- options() 
	on.exit(options(old)) 
    options("superb.feedback" = c('warnings'))

    library(ggplot2)
    library(gridExtra)
    dta9 <- GRD( WSFactors = "Moment(3)", SubjectsPerGroup = 5, 
        Population = list( mean=20, stddev = 5),
        Effects = list("Moment" = slope(3) ) )
    # write.table(dta9, file = "file9.dat", sep = "\t", col.names = FALSE)

    expect_message( 
        truecm <- superbPlot(dta9, WSFactor = "moment(3)",
          adjustments=list(decorrelation="CM"),
          errorbar = "CI", showPlot=T,
          variables = c("DV.1","DV.2","DV.3") 
        )+ labs(title="With decorrelation = CM") 
    )
    altcm <- superbPlot(dta9, WSFactor = "moment(3)", 
      adjustments=list(decorrelation="none"),
      preprocessfct = "subjectCenteringTransform",
      postprocessfct = c("biasCorrectionTransform"),
      errorbar = "CI", showPlot=T,
      variables = c("DV.1","DV.2","DV.3") 
    )+ labs(title="with pre and post processing")
    pcm <- grid.arrange(truecm,altcm,ncol=2)

    expect_message( 
        truelm <- superbPlot(dta9, WSFactor = "moment(3)", 
          adjustments=list(decorrelation="LM"),
          errorbar = "CI", showPlot=T,
          variables = c("DV.1","DV.2","DV.3") 
        )+ labs(title="with decorrelation = LM") 
    )
    altlm <- superbPlot(dta9, WSFactor = "moment(3)", 
      adjustments=list(decorrelation="none"),
      preprocessfct = "subjectCenteringTransform",
      postprocessfct = c("biasCorrectionTransform","poolSDTransform"),
      errorbar = "CI", showPlot=T,
      variables = c("DV.1","DV.2","DV.3") 
    )+ labs(title="with pre and post processing")
    plm <- grid.arrange(truelm,altlm,ncol=2)

    expect_message( 
        truecmvslm <- superbPlot(dta9, WSFactor = "moment(3)", 
          adjustments=list(decorrelation="LM"),
          errorbar = "CI", showPlot=T,
          variables = c("DV.1","DV.2","DV.3") 
        )+ labs(title="with decorrelation = LM") 
    )
    expect_message( altcmvslm <- superbPlot(dta9, WSFactor = "moment(3)", 
        adjustments=list(decorrelation="CM"),
        postprocessfct = c("poolSDTransform"),
        errorbar = "CI", showPlot=T,
        variables = c("DV.1","DV.2","DV.3") 
        )+ labs(title="with decorrelation = CM and pooling") 
    )
    pcmvslm <- grid.arrange(truecmvslm,altcmvslm,ncol=2)
    
    expect_equal( "ggplot" %in% class(truecm), TRUE)
    expect_equal( "ggplot" %in% class(altcm), TRUE)
    expect_equal( "ggplot" %in% class(truelm), TRUE)
    expect_equal( "ggplot" %in% class(altlm), TRUE)
    expect_equal( "ggplot" %in% class(truecmvslm), TRUE)
    expect_equal( "ggplot" %in% class(altcmvslm), TRUE)
    # restores default information
    options("superb.feedback" = c('design','warnings','summary'))
})



#########################################
# testing Violinplots a bit more!
#########################################
test_that("Many tests with the extended violin format", {
	old <- options() 
	on.exit(options(old)) 
    options("superb.feedback" = c('none'))

    library(ggplot2)
    dta9 <- GRD( WSFactors = "Moment(3)", SubjectsPerGroup = 500, 
        Population = list( mean=20, stddev = 5),
        Effects = list("Moment" = slope(3) ) )

    plt1 <- superbPlot(dta9,
            WSFactor = "T(2)",
            variables = c("DV.1","DV.2"),
            adjustments = list(purpose="difference", decorrelation="CM"),
            plotStyle = "pointjitterviolin",
            violinParams = list(alpha =0.7, color="red")
        ) 
    plt2 <- superbPlot(dta9,
            WSFactor = "T(2)",
            variables = c("DV.1","DV.2"),
            adjustments = list(purpose="difference", decorrelation="CM"),
            plotStyle = "pointjitterviolin",
            jitterParams = list(width = 0.1),
            violinParams = list(alpha =0.7, color="red", direction=1, push=0.1)
        ) 
    plt3 <- superbPlot(dta9,
            WSFactor = "T(2)",
            variables = c("DV.1","DV.2"),
            adjustments = list(purpose="difference", decorrelation="CM"),
            plotStyle = "pointjitterviolin",
            jitterParams = list(width = 0.1),
            violinParams = list(alpha =0.7, color="red", direction=-1, push=0.1)
        ) 
    plt4 <- superbPlot(dta9,
            WSFactor = "T(2)",
            variables = c("DV.1","DV.2"),
            adjustments = list(purpose="difference", decorrelation="CM"),
            plotStyle = "raincloud",
            violinParams = list(alpha =0.7, color="red", direction=-1)
        ) 
    plt5 <- superbPlot(dta9,
            WSFactor = "T(2)",
            variables = c("DV.1","DV.2"),
            adjustments = list(purpose="difference", decorrelation="CM"),
            plotStyle = "raincloud",
            jitterParams = list(width = 0.1),
            violinParams = list(alpha =0.7, color="red", direction=-1, push=0.1)
        ) 
    plt6 <- superbPlot(dta9,
            WSFactor = "T(2)",
            variables = c("DV.1","DV.2"),
            adjustments = list(purpose="difference", decorrelation="CM"),
            plotStyle = "raincloud",
            jitterParams = list(width = 0.1),
            violinParams = list(alpha =0.7, color="red", direction=+1, push=0.1)
        ) 

    expect_error( print(plt1), NA )
    expect_error( print(plt2), NA )
    expect_error( print(plt3), NA )
    expect_error( print(plt4), NA )
    expect_error( print(plt5), NA )
    expect_error( print(plt6), NA )
    expect_equal( "ggplot" %in% class(plt1), TRUE)
    expect_equal( "ggplot" %in% class(plt2), TRUE)
    expect_equal( "ggplot" %in% class(plt3), TRUE)
    expect_equal( "ggplot" %in% class(plt4), TRUE)
    expect_equal( "ggplot" %in% class(plt5), TRUE)
    expect_equal( "ggplot" %in% class(plt6), TRUE)

    # restores default information
    options("superb.feedback" = c('design','warnings','summary'))
})



#########################################
# testing multiple formats!
#########################################

test_that("Many tests with TMB1964r", {
	old <- options() 
	on.exit(options(old)) 
    options("superb.feedback" = c('none'))

    library(ggplot2)
    mee = TMB1964r[TMB1964r$Language == "English"|TMB1964r$Language == "French",]

    mp <- function(style, ...) {
        superbPlot(mee,
            WSFactor = "T(7)",
            BSFactor = c("Condition","Sex"),
            variables = c("T1","T2","T3","T4","T5","T6","T7"),
            adjustments = list(purpose="difference", decorrelation="CM"),
            plotStyle = style,
            ...
        ) 
    }
    ###### BASIC PLOTS ######
    plt1 <- mp("bar",
        errorbarParams = list(linewidth=0.75, position = position_dodge(.95) ),
        barParams = list(linewidth=0.5)
    ) + 
    scale_colour_manual( name = "asdf", 
        labels = c("Context 0", "Context 2", "Context 4", "Context 8"), 
        values = c("blue", "black", "purple", "red")) +
    scale_fill_manual( name = "asdf", 
        labels = c("Context 0", "Context 2", "Context 4", "Context 8"), 
        values = c("blue", "black", "purple", "red")) +
    theme_bw(base_size = 16) +
    labs(x = "Exposure duration (ms)", y = "Mean of correct responses" )+ 
    scale_x_discrete(labels=c("1" = "16.67", "2" = "33.33",
        "3"="50.00", "4" = "66.67", "5"="83.33", "6"="100.00", "7"="116.67"))

    plt2 <- mp("line",
        errorbarParams = list(linewidth=0.75, width = 0.2, position = position_dodge(.5) ),
        pointParams = list(size=2.5, position = position_dodge(.5)),
        lineParams = list(linewidth=0.25)
    )

    plt3 <- mp("point",
        errorbarParams = list(position = position_dodge(.5) ),
        pointParams = list(size=2.5, position = position_dodge(.5))
    )

    ###### ADVANCED PLOTS ######
    plt4 <- mp("pointjitter",
        errorbarParams = list(position = position_dodge(.5) ),
        pointParams = list(size=3.5, position = position_dodge(.5)),
        jitterParams = list(size = 0.5)
    )

    plt5 <- mp("pointjitterviolin",
        errorbarParams = list(position = position_dodge(.5) ),
        pointParams = list(size=3.5, position = position_dodge(.5)),
        jitterParams = list(size = 0.5),
        violinParams = list(alpha =0.7)
    )

    dta <- superb::GRD( WSFactors = "timepoints (100) : condition(2)", 
        SubjectsPerGroup = 40,
        RenameDV = "activation",
        Effects = list("timepoints" = extent(5), "condition" = extent(3) ),
        Population=list(mean=50,stddev=10,rho=0.75)
    )
    plt6 <- superbPlot(dta, 
       WSFactors   = c("timepoints(100)", "condition(2)"),
       variables = colnames(dta)[2:201],   ## all the names of the dataframe except "id"
       adjustments = list(
            purpose       = "single",
            decorrelation = "CM"        ## or none for no decorrelation
       ),
       plotStyle="lineBand",            # note the uppercase B 
       pointParams = list(size= 1) 
    )

    expect_error( print(plt1), NA )
    expect_error( print(plt2), NA )
    expect_error( print(plt3), NA )
    expect_error( print(plt4), NA )
    expect_error( print(plt5), NA )
    expect_error( print(plt6), NA )
    expect_equal( "ggplot" %in% class(plt1), TRUE)
    expect_equal( "ggplot" %in% class(plt2), TRUE)
    expect_equal( "ggplot" %in% class(plt3), TRUE)
    expect_equal( "ggplot" %in% class(plt4), TRUE)
    expect_equal( "ggplot" %in% class(plt5), TRUE)
    expect_equal( "ggplot" %in% class(plt6), TRUE)

    # restores default information
    options("superb.feedback" = c('design','warnings','summary'))
})


test_that("Heterogeneous variances", {
	old <- options() 
	on.exit(options(old)) 
    options("superb.feedback" = c('none'))

    dta <- GRD(
        BSFactors = "dif(3) : grp (2)", 
        WSFactors="day(1,2)",
        SubjectsPerGroup = 3,
        Population=list(
            mean = 100, 
            scores = "rnorm(1, mean = GM, sd = 100 * (grp-1) +0.1)"
        )
    )
    options("superb.feedback" = c('warnings'))
    expect_message( 
        superbPlot(dta,
            BSFactor = c("dif","grp"),
            WSFactor = "day(2)",
            variables = c("DV.1","DV.2"),
            adjustment = list( purpose = "difference") )
    )
	options("superb.feedback" = c('none'))
    plt <- superbPlot(dta,
        BSFactor = c("dif","grp"),
        WSFactor = "day(2)",
        variables = c("DV.1","DV.2"),
        adjustment = list( purpose = "tryon") )

    expect_equal( "ggplot" %in% class(plt), TRUE )
    # restores default information
    options("superb.feedback" = c('design','warnings','summary'))
})


test_that("Tryon vs. difference", {
	old <- options() 
	on.exit(options(old)) 
    options("superb.feedback" = c('warnings'))

    #lets have data with massively heterogeneous variances
    dta <-GRD( BSFactors="grp(3)",
        RenameDV = "score",
        Population=list(
            mean = 100, 
            scores = "rnorm(1, mean = GM, sd = 10 * grp)"
        ),
        SubjectsPerGroup = 50,
        Effects = list("grp" = slope(15) ) 
    )
    # do the plot twice with transparant background
    expect_message(plt1 <- superbPlot(dta, 
        BSFactor = "grp", plotStyle="line",
        variables = "score",  
        errorbarParams = list(color="blue",position = position_nudge(-0.1) ),
        adjustments = list( purpose = "difference") ) + 
     labs(title="(blue) Difference-adjusted 95% confidence intervals\n(red) Tryon 95% confidence intervals") +
     coord_cartesian( ylim = c(65,135) ) + 
     theme(panel.background = element_rect(fill = "transparent"),
           plot.background = element_rect(fill = "transparent", color = "white")) 
    )
    expect_message(plt2 <- superbPlot(dta, 
        BSFactor = c("grp"), plotStyle="line",
        variables = "score",  
        errorbarParams = list(color="red",position = position_nudge(+0.1) ),
        adjustments = list( purpose = "tryon") ) +
     labs(title="(blue) Difference-adjusted 95% confidence intervals\n(red) Tryon 95% confidence intervals") +
     coord_cartesian( ylim = c(65,135) ) + 
     theme(panel.background = element_rect(fill = "transparent"),
           plot.background = element_rect(fill = "transparent", color = "white")) )
    # transform the plots in manipulable objets
    plt1g <- ggplotGrob(plt1)
    plt2g <- ggplotGrob(plt2)
    # put the two grob onto an empty ggplot (as the positions are the same, they will be overlayed)
    plt <- ggplot() + 
        annotation_custom(grob=plt1g) + 
        annotation_custom(grob=plt2g)
    expect_equal( "ggplot" %in% class(plt), TRUE)
    # restores default information
    options("superb.feedback" = c('design','warnings','summary'))
})

Try the superb package in your browser

Any scripts or data that you put into this service are public.

superb documentation built on Sept. 11, 2024, 8:10 p.m.