tests/testthat/test-ANOPA-6-PASFAIT.R

In ANOPA: Analyses of Proportions using Anscombe Transform

# context("ANOPA:: Testing contrastProportions} function")
    # # expect_output( str(res), "data.frame")
    # # expect_equal( "ggplot" %in% class(plt), TRUE)
    # # expect_message( p <- superbPlot(dta2a, etc ))
    # # expect_error(), expect_warning(), expect_condition( , class = "")


# test_that("TESTS of contrastFrequencies function(1/2)", {

    # w <- anofa(Frequency ~ Intensity * Pitch, minimalExample) 
    # c <- contrastFrequencies(w, 
        # list(c1=c(1,-1,0,0,0,0)/1, 
             # c2=c(1,1,-2,0,0,0)/2,
             # c3=c(1,1,1,-3,0,0)/3,
             # c4=c(1,1,1,1,-4,0)/4,
             # c5=c(1,1,1,1,1,-5)/5
        # )
    # )
    # expect_equal(sum(c$results[,1]), w$results[1,1], tolerance = 0.0001)

    # e <- emFrequencies(w, ~ Intensity | Pitch)
    # f <- contrastFrequencies(e, list(c1=c(1,1,-2)/2, c2=c(1,-1,0)))
    # expect_equal(sum(f$results[,1]), w$results[1,1], tolerance = 0.0001)

    # # not an anofa object (error 31)
    # expect_error( contrastFrequencies(22, list(c1=c(1,1,-2)/1, c2=c(1,-1,0))) )
    # # contrast unequal length (error 32)
    # expect_error( contrastFrequencies(w, list(c1=c(1,1,-2)/1, c2=c(1,-1))) )
    # # contrast length does not match design (error 33)
    # expect_error( contrastFrequencies(w, list(c1=c(1,-1)/1, c2=c(1,-1))) )
    # # too many contrasts (error 34)
    # expect_error( contrastFrequencies(e, list(c1=c(1,1,-2)/1, c2=c(1,-1,0), c3=c(0,1,01))) ) 
    # # cross product does not sum to 1 (error 35)
    # expect_error( contrastFrequencies(e, list(c1=c(1,1,-2)/2, c2=c(1,0,-1))) ) 
    # # amplitude not 1 (error 36)
    # expect_error( contrastFrequencies(e, list(c1=c(1,1,-2)/1, c2=c(1,-1,0))) ) 

# })

# test_that("TESTS of contrastFrequencies function (2/2)", {

    # ##########################################################
    # # Testing the dataset's example
    # ##########################################################

    # #### LANDIS ET AL., 2013 ####
    # L <- anofa( obsfreq ~ provider * program, LandisBarrettGalvin2013)
    # c <- contrastFrequencies(L, list(
        # c1=c(1,-01,0,0,0,0,0,0,0,0,0,0,0,0,0)/1, 
        # c2=c(1,1,-02,0,0,0,0,0,0,0,0,0,0,0,0)/2, 
        # c3=c(1,1,1,-03,0,0,0,0,0,0,0,0,0,0,0)/3, 
        # c4=c(1,1,1,1,-04,0,0,0,0,0,0,0,0,0,0)/4, 
        # c5=c(1,1,1,1,1,-05,0,0,0,0,0,0,0,0,0)/5, 
        # c6=c(1,1,1,1,1,1,-06,0,0,0,0,0,0,0,0)/6, 
        # c7=c(1,1,1,1,1,1,1,-07,0,0,0,0,0,0,0)/7, 
        # c8=c(1,1,1,1,1,1,1,1,-08,0,0,0,0,0,0)/8, 
        # c9=c(1,1,1,1,1,1,1,1,1,-09,0,0,0,0,0)/9, 
        # cA=c(1,1,1,1,1,1,1,1,1,1,-10,0,0,0,0)/10, 
        # cB=c(1,1,1,1,1,1,1,1,1,1,1,-11,0,0,0)/11, 
        # cC=c(1,1,1,1,1,1,1,1,1,1,1,1,-12,0,0)/12, 
        # cD=c(1,1,1,1,1,1,1,1,1,1,1,1,1,-13,0)/13, 
        # cE=c(1,1,1,1,1,1,1,1,1,1,1,1,1,1,-14)/14
        # ))
    # expect_equal(sum(c$results[,1]), L$results[1,1], tolerance = 0.0001)

    # e <- emFrequencies(L, ~ program | provider)
    # f <- contrastFrequencies(e, list(
            # "(PBH & CBH) vs. BM"=c(1,1,-2)/2, 
            # "PBH vs. CBH"=c(1,-1,0))
        # )
    # expect_equal(f$results[1,1], 18.6215, tolerance = 0.0001)
    # expect_equal(sum(f$results[,1]) + L$results[2,1], L$results[1,1], tolerance = 0.0001)


    # #### LIGHT & MARGOLIN, 1971 ####
    # L <- anofa( obsfreq ~ vocation * gender, LightMargolin1971)
    # c <- contrastFrequencies(L, list(
        # c1=c(1,-01,0,0,0,0,0,0,0,0)/1, 
        # c2=c(1,1,-02,0,0,0,0,0,0,0)/2, 
        # c3=c(1,1,1,-03,0,0,0,0,0,0)/3, 
        # c4=c(1,1,1,1,-04,0,0,0,0,0)/4, 
        # c5=c(1,1,1,1,1,-05,0,0,0,0)/5, 
        # c6=c(1,1,1,1,1,1,-06,0,0,0)/6, 
        # c7=c(1,1,1,1,1,1,1,-07,0,0)/7, 
        # c8=c(1,1,1,1,1,1,1,1,-08,0)/8, 
        # c9=c(1,1,1,1,1,1,1,1,1,-09)/9
        # ))
    # expect_equal(sum(c$results[,1]), L$results[1,1], tolerance = 0.0001)

    # e <- emFrequencies(L, ~ vocation | gender )
    # f <- contrastFrequencies(e, list(
            # "teacher college vs. gymnasium"=c( 0, 0, 1,-1, 0),
            # "vocational vs. university"   = c( 0, 1, 0, 0,-1),
            # "another"                     = c( 0, 1,-1,-1,+1)/2,
            # "to exhaust the df"           = c( 4,-1,-1,-1,-1)/4
            # )
        # )
    # expect_equal(f$results[1,1], 0.8325, tolerance = 0.0001)
    # expect_equal(sum(f$results[,1]) + L$results[3,1], L$results[1,1], tolerance = 0.0001)


    # #### Les greffons GILLET, 1993 ####
    # G <- anofa( Freq ~ species * location * florished, Gillet1993)
    # e <- emFrequencies(G, ~ location | species * florished) 
    # f <- contrastFrequencies(e, list(
            # "order 1 vs. 2&3"    = c( 2,-1,-1)/2,
            # "order 2 vs order 3" = c( 0, 1,-1)
            # )
        # )
    # expect_equal(f$results[1,1], 91.7686, tolerance = 0.0001)
    # expect_equal(sum(f$results[,1])+G$results[4,1]+G$results[2,1]+G$results[6,1], G$results[1,1], tolerance = 0.0001)


    # #### Detergent RIES ET SMITH, 1963 ####
# # Removed because Prof Ripley is not happy
# #    dta <- data.frame(Detergent)
# #    R <- anofa( Freq ~  Temperature * M_User * Preference * Water_softness, dta)
# #    e <- emFrequencies(R, ~ Water_softness | Temperature ) 

# #    f <- contrastFrequencies(e, list(
# #            "soft vs. medium" = c( 1,-1, 0),
# #            "both vs. hard"   = c( 1, 1,-2)/2
# #            )
# #        )
# #    expect_equal(sum(f$results[,1]), sum(e$results[,1]), tolerance = 0.0001)
# #    expect_equal(sum(f$results[,1]), sum(R$results[c(5,8),1]), tolerance = 0.0001)

# })

# test_that("TESTS of contrastFrequencies function (3/3)", {

    # ##########################################################
    # # Testing contrasts with random frequencies
    # ##########################################################

    # # ==============================================================
    # # testing (2x3) design
    # set.seed(42)
    # dta <- GRF( list(A=c("a1","a2"), B=c("b1","b2","b3") ), 100,
        # c(rep(1/10,5),1/2)    )    ## results in an interaction A:B
    # w <- anofa( Freq ~ A * B, dta)

    # # decomposition of B for each level of A
    # e <- emFrequencies(w, ~ B | A )
    # f <- contrastFrequencies(e, list(
            # "a1 vs. a2"      = c( 1,-1, 0),
            # "(a1&a2) vs. a3" = c( 1, 1,-2)/2  ))
    # gA <- sum(w$results[c(3,4),1])   # B et B:A
    # gB <- sum(e$results[,1])
    # gC <- sum(f$results[,1])
    # expect_equal(gA, gB, tolerance = 0.0001)
    # expect_equal(gA, gC, tolerance = 0.0001)

    # # ==============================================================
    # # testing (2x3x4) design: B | A, B | A*C, A*B | C
    # set.seed(42)
    # dta <- GRF( list(A=c("a1","a2"), B=c("b1","b2","b3"), C=c("c1","c2","c3","c4") ), 100,
        # c(rep(1/50,23),.54)    )    ## results in an interaction A:B
    # w <- anofa( Freq ~ A * B * C, dta)

    # # decomposition of B for each level of A
    # e <- emFrequencies(w, ~ B | A )
    # f <- contrastFrequencies(e, list(
            # "a1 vs. a2"      = c( 1,-1, 0),
            # "(a1&a2) vs. a3" = c( 1, 1,-2)/2  ))
    # gA <- sum(w$results[c(3,5),1])   # B et B:A
    # gB <- sum(e$results[,1])
    # gC <- sum(f$results[,1])
    # expect_equal(gA, gB, tolerance = 0.0001)
    # expect_equal(gA, gC, tolerance = 0.0001)

    # # decomposition of B for each level of A*C
    # e <- emFrequencies(w, ~ B | A*C )
    # f <- contrastFrequencies(e, list(
            # "a1 vs. a2"      = c( 1,-1, 0),
            # "(a1&a2) vs. a3" = c( 1, 1,-2)/2  ))
    # gA <- sum(w$results[c(3,5,7,8),1])   # B, B:A, B:C, B:A:C
    # gB <- sum(e$results[,1])
    # gC <- sum(f$results[,1])
    # expect_equal(gA, gB, tolerance = 0.0001)
    # expect_equal(gA, gC, tolerance = 0.0001)

    # # decomposition of A*B for each level of C
    # e <- emFrequencies(w, ~ A*B | C )
    # f <- contrastFrequencies(e, list(
            # "c1" = c( 1,-1, 0, 0, 0, 0)/1,
            # "c2" = c( 1, 1,-2, 0, 0, 0)/2,
            # "c3" = c( 1, 1, 1,-3, 0, 0)/3,
            # "c4" = c( 1, 1, 1, 1,-4, 0)/4,
            # "c5" = c( 1, 1, 1, 1, 1,-5)/5
        # ))
    # gA <- sum(w$results[c(2,3,5,6,7,8),1])   # A, B, A:B, A:C, B:C, A:B:C
    # gB <- sum(e$results[,1])
    # gC <- sum(f$results[,1])
    # expect_equal(gA, gB, tolerance = 0.0001)
    # expect_equal(gA, gC, tolerance = 0.0001)


    # # ==============================================================
    # # testing (2x3x2x2) design: B | A, B | A*C, A*B | C
    # set.seed(42)
    # dta <- GRF( list(A=c("a1","a2"), B=c("b1","b2","b3"), C=c("c1","c2"), D=c("d1","d2") ), 200,
        # c(rep(1/50,23),.54)    )    ## results in an interaction A:B
    # w <- anofa( Freq ~ A * B * C * D, dta)

    # # decomposition of B for each level of A
    # e <- emFrequencies(w, ~ B | A )
    # f <- contrastFrequencies(e, list(
            # "a1 vs. a2"      = c( 1,-1, 0),
            # "(a1&a2) vs. a3" = c( 1, 1,-2)/2  ))
    # gA <- sum(w$results[c(3,6),1])   # B et B:A
    # gB <- sum(e$results[,1])
    # gC <- sum(f$results[,1])
    # expect_equal(gA, gB, tolerance = 0.0001)
    # expect_equal(gA, gC, tolerance = 0.0001)

    # # decomposition of B for each level of A*C
    # e <- emFrequencies(w, ~ B | A*C )
    # f <- contrastFrequencies(e, list(
            # "a1 vs. a2"      = c( 1,-1, 0),
            # "(a1&a2) vs. a3" = c( 1, 1,-2)/2  ))
    # gA <- sum(w$results[c(3,6,9,12),1])   # B, B:A, B:C, B:A:C
    # gB <- sum(e$results[,1])
    # gC <- sum(f$results[,1])
    # expect_equal(gA, gB, tolerance = 0.0001)
    # expect_equal(gA, gC, tolerance = 0.0001)

    # # decomposition of A*B for each level of C
    # e <- emFrequencies(w, ~ A*B | C )
    # f <- contrastFrequencies(e, list(
            # "c1" = c( 1,-1, 0, 0, 0, 0)/1,
            # "c2" = c( 1, 1,-2, 0, 0, 0)/2,
            # "c3" = c( 1, 1, 1,-3, 0, 0)/3,
            # "c4" = c( 1, 1, 1, 1,-4, 0)/4,
            # "c5" = c( 1, 1, 1, 1, 1,-5)/5
        # ))
    # gA <- sum(w$results[c(2,3,6,7,9,12),1])   # A, B, A:B, A:C, B:C, A:B:C
    # gB <- sum(e$results[,1])
    # gC <- sum(f$results[,1])
    # expect_equal(gA, gB, tolerance = 0.0001)
    # expect_equal(gB, gC, tolerance = 0.0001)

    # # decomposition of A*B for each level of C*D
    # e <- emFrequencies(w, ~ A*B | C*D )
    # f <- contrastFrequencies(e, list(
            # "c1" = c( 1,-1, 0, 0, 0, 0)/1,
            # "c2" = c( 1, 1,-2, 0, 0, 0)/2,
            # "c3" = c( 1, 1, 1,-3, 0, 0)/3,
            # "c4" = c( 1, 1, 1, 1,-4, 0)/4,
            # "c5" = c( 1, 1, 1, 1, 1,-5)/5
        # ))
    # gA <- sum(w$results[c(2,3,6,7,8,9,10,12,13,14,15,16),1])   # tout sauf C, D, C*D
    # gB <- sum(e$results[,1])
    # gC <- sum(f$results[,1])
    # expect_equal(gA, gB, tolerance = 0.0001)
    # expect_equal(gB, gC, tolerance = 0.0001)


# })