Rjamovi: The 'jamovi' Analyses

testthat::context('conttables')

testthat::test_that('All options in the contTables work (sunny)', {
    suppressWarnings(RNGversion("3.5.0"))
    set.seed(1337)

    df <- data.frame(
        `x 1` = sample(letters[1:2], 100, replace = TRUE),
        y = sample(LETTERS[1:2], 100, replace = TRUE),
        stringsAsFactors = TRUE,
        check.names = FALSE
    )

    r <- jmv::contTables(
        data=df,
        rows="x 1",
        cols="y",
        chiSqCorr = TRUE,
        zProp = TRUE,
        likeRat = TRUE,
        fisher = TRUE,
        contCoef = TRUE,
        phiCra = TRUE,
        diffProp = TRUE,
        logOdds = TRUE,
        odds = TRUE,
        relRisk = TRUE,
        gamma = TRUE,
        taub = TRUE,
        mh = TRUE,
        exp = TRUE,
        pcRow = TRUE,
        pcCol = TRUE,
        pcTot = TRUE
    )

    # Test main contingency tables
    mainTable <- r$freqs$asDF
    testthat::expect_equal(c('a', 'b', 'Total'), mainTable[['x 1']])
    testthat::expect_equal(c('Observed', 'Observed', 'Observed'), mainTable[['type[count]']])
    testthat::expect_equal(c('Expected', 'Expected', 'Expected'), mainTable[['type[expected]']])
    testthat::expect_equal(
        c('% within row', '% within row', '% within row'), mainTable[['type[pcRow]']]
    )
    testthat::expect_equal(
        c('% within column', '% within column', '% within column'), mainTable[['type[pcCol]']]
    )
    testthat::expect_equal(c('% of total', '% of total', '% of total'), mainTable[['type[pcTot]']])
    testthat::expect_equal(c(23, 28, 51), mainTable[['1[count]']])
    testthat::expect_equal(c(22.95, 28.05, 51), mainTable[['1[expected]']], tolerance = 1e-3)
    testthat::expect_equal(c(0.511, 0.509, 0.51), mainTable[['1[pcRow]']], tolerance = 1e-3)
    testthat::expect_equal(c(0.451, 0.549, 1), mainTable[['1[pcCol]']], tolerance = 1e-3)
    testthat::expect_equal(c(0.23, 0.28, 0.51), mainTable[['1[pcTot]']], tolerance = 1e-3)
    testthat::expect_equal(c(22, 27, 49), mainTable[['2[count]']])
    testthat::expect_equal(c(22.05, 26.95, 49), mainTable[['2[expected]']], tolerance = 1e-3)
    testthat::expect_equal(c(0.489, 0.491, 0.49), mainTable[['2[pcRow]']], tolerance = 1e-3)
    testthat::expect_equal(c(0.449, 0.551, 1), mainTable[['2[pcCol]']], tolerance = 1e-3)
    testthat::expect_equal(c(0.22, 0.27, 0.49), mainTable[['2[pcTot]']], tolerance = 1e-3)
    testthat::expect_equal(c(45, 55, 100), mainTable[['.total[count]']])
    testthat::expect_equal(c(45, 55, 100), mainTable[['.total[exp]']], tolerance = 1e-3)
    testthat::expect_equal(c(1, 1, 1), mainTable[['.total[pcRow]']], tolerance = 1e-3)
    testthat::expect_equal(c(0.45, 0.55, 1), mainTable[['.total[pcCol]']], tolerance = 1e-3)
    testthat::expect_equal(c(0.45, 0.55, 1), mainTable[['.total[pcTot]']], tolerance = 1e-3)

    # Test chi squared tests table
    chiSqTable <- r$chiSq$asDF
    testthat::expect_equal('χ²', chiSqTable[['test[chiSq]']])
    testthat::expect_equal(0, chiSqTable[['value[chiSq]']], tolerance = 1e-3)
    testthat::expect_equal(1, chiSqTable[['df[chiSq]']], tolerance = 1e-3)
    testthat::expect_equal(0.984, chiSqTable[['p[chiSq]']], tolerance = 1e-3)
    testthat::expect_equal('χ² continuity correction', chiSqTable[['test[chiSqCorr]']])
    testthat::expect_equal(0, chiSqTable[['value[chiSqCorr]']], tolerance = 1e-3)
    testthat::expect_equal(1, chiSqTable[['df[chiSqCorr]']], tolerance = 1e-3)
    testthat::expect_equal(1, chiSqTable[['p[chiSqCorr]']], tolerance = 1e-3)
    testthat::expect_equal('z test difference in 2 proportions', chiSqTable[['test[zProp]']])
    testthat::expect_equal(0.02, chiSqTable[['value[zProp]']], tolerance = 1e-3)
    testthat::expect_equal(NA, chiSqTable[['df[zProp]']], tolerance = 1e-3)
    testthat::expect_equal(0.984, chiSqTable[['p[zProp]']], tolerance = 1e-3)
    testthat::expect_equal('Likelihood ratio', chiSqTable[['test[likeRat]']])
    testthat::expect_equal(0, chiSqTable[['value[likeRat]']], tolerance = 1e-3)
    testthat::expect_equal(1, chiSqTable[['df[likeRat]']], tolerance = 1e-3)
    testthat::expect_equal(0.984, chiSqTable[['p[likeRat]']], tolerance = 1e-3)
    testthat::expect_equal('Fisher\'s exact test', chiSqTable[['test[fisher]']])
    testthat::expect_equal(NA, chiSqTable[['value[fisher]']], tolerance = 1e-3)
    testthat::expect_equal(1, chiSqTable[['p[fisher]']], tolerance = 1e-3)
    testthat::expect_equal('N', chiSqTable[['test[N]']], tolerance = 1e-3)
    testthat::expect_equal(100, chiSqTable[['value[N]']], tolerance = 1e-3)


    # Test comparative measures table
    compMeasuresTable <- r$odds$asDF
    testthat::expect_equal('Difference in 2 proportions', compMeasuresTable[['t[dp]']])
    testthat::expect_equal(0.002, compMeasuresTable[['v[dp]']], tolerance = 1e-3)
    testthat::expect_equal(-0.195, compMeasuresTable[['cil[dp]']], tolerance = 1e-3)
    testthat::expect_equal(0.199, compMeasuresTable[['ciu[dp]']], tolerance = 1e-3)
    testthat::expect_equal('Log odds ratio', compMeasuresTable[['t[lo]']])
    testthat::expect_equal(0.008, compMeasuresTable[['v[lo]']], tolerance = 1e-3)
    testthat::expect_equal(-0.78, compMeasuresTable[['cil[lo]']], tolerance = 1e-3)
    testthat::expect_equal(0.796, compMeasuresTable[['ciu[lo]']], tolerance = 1e-3)
    testthat::expect_equal('Odds ratio', compMeasuresTable[['t[o]']])
    testthat::expect_equal(1.008, compMeasuresTable[['v[o]']], tolerance = 1e-3)
    testthat::expect_equal(0.458, compMeasuresTable[['cil[o]']], tolerance = 1e-3)
    testthat::expect_equal(2.217, compMeasuresTable[['ciu[o]']], tolerance = 1e-3)
    testthat::expect_equal('Relative risk', compMeasuresTable[['t[rr]']])
    testthat::expect_equal(1.004, compMeasuresTable[['v[rr]']], tolerance = 1e-3)
    testthat::expect_equal(0.682, compMeasuresTable[['cil[rr]']], tolerance = 1e-3)
    testthat::expect_equal(1.477, compMeasuresTable[['ciu[rr]']], tolerance = 1e-3)


    # Test nominal table
    nominalTable <- r$nom$asDF
    testthat::expect_equal('Contingency coefficient', nominalTable[['t[cont]']])
    testthat::expect_equal(0.002, nominalTable[['v[cont]']], tolerance = 1e-3)
    testthat::expect_equal('Phi-coefficient', nominalTable[['t[phi]']])
    testthat::expect_equal(0.002, nominalTable[['v[phi]']], tolerance = 1e-3)
    testthat::expect_equal('Cramer\'s V', nominalTable[['t[cra]']])
    testthat::expect_equal(0.002, nominalTable[['v[cra]']], tolerance = 1e-3)

    # Test gamma table
    gammaTable <- r$gamma$asDF
    testthat::expect_equal(0.004, gammaTable[['gamma']], tolerance = 1e-3)
    testthat::expect_equal(0.201, gammaTable[['se']], tolerance = 1e-3)
    testthat::expect_equal(-0.39, gammaTable[['cil']], tolerance = 1e-3)
    testthat::expect_equal(0.398, gammaTable[['ciu']], tolerance = 1e-3)

    # Test Kendall's tau table
    tauTable <- r$taub$asDF
    testthat::expect_equal(0.002, tauTable[['taub']], tolerance = 1e-3)
    testthat::expect_equal(0.02, tauTable[['t']], tolerance = 1e-3)
    testthat::expect_equal(0.984, tauTable[['p']], tolerance = 1e-3)

    # Test Mantel-Haenszel test table
    mhTable <- r$mh$asDF
    testthat::expect_equal(0, mhTable[['chi2']], tolerance = 1e-3)
    testthat::expect_equal(1, mhTable[['df']], tolerance = 1e-3)
    testthat::expect_equal(0.984, mhTable[['p']], tolerance = 1e-3)
})

testthat::test_that('conttables works without counts', {
    suppressWarnings(RNGversion("3.5.0"))
    set.seed(100)

    x <- factor(sample(c("A","B"), 100, replace = TRUE), c("A","B"))
    y <- factor(sample(c("I","II"), 100, replace = TRUE), c("I","II"))
    z <- factor(sample(c("foo","bar"), 100, replace = TRUE), c("foo","bar"))
    w <- factor(sample(c("fred","steve"), 100, replace = TRUE), c("fred","steve"))

    data1 <- data.frame(x = x, y = y, z = z, w = w)

    table1<- jmv::contTables(data=data1, rows="x", cols="y")

    freqs1 <- as.data.frame(table1$freqs)

    testthat::expect_equal(28, freqs1[1, '1[count]'])
    testthat::expect_equal(22, freqs1[1, '2[count]'])
    testthat::expect_equal(22, freqs1[2, '1[count]'])
    testthat::expect_equal(28, freqs1[2, '2[count]'])

    table2 <- jmv::contTables(data=data1, rows="x", cols="y", layers=c("z","w"))

    freqs2 <- as.data.frame(table2$freqs)

    testthat::expect_equal(28, freqs2[25, '1[count]'])
    testthat::expect_equal(22, freqs2[25, '2[count]'])
    testthat::expect_equal(22, freqs2[26, '1[count]'])
    testthat::expect_equal(28, freqs2[26, '2[count]'])

    testthat::expect_equal(9, freqs2[10, '1[count]'])
    testthat::expect_equal(4, freqs2[10, '2[count]'])
    testthat::expect_equal(4, freqs2[11, '1[count]'])
    testthat::expect_equal(6, freqs2[11, '2[count]'])
})

testthat::test_that("conttables works with counts", {
    suppressWarnings(RNGversion("3.5.0"))
    set.seed(212)

    rows <- factor(c("A","B","C","A","B","C","A","B","C","A","B","C"), c("A","B","C"))
    cols <- factor(c("1","1","1","2","2","2","1","1","1","2","2","2"), c("1","2"))
    layer <- factor(c("I","I","I","I","I","I","II","II","II","II","II","II"), c("I","II"))
    counts <- sample(0:20, 12, replace = TRUE)

    data <- data.frame(rows = rows, cols = cols, layer = layer, counts = counts)

    table <- jmv::contTables(data=data, rows="rows", cols="cols", layers="layer", counts="counts")

    freqs <- as.data.frame(table$freqs)

    testthat::expect_equal(8, freqs[1, '1[count]'])
    testthat::expect_equal(3, freqs[1, '2[count]'])
    testthat::expect_equal(17, freqs[2, '1[count]'])
    testthat::expect_equal(0, freqs[2, '2[count]'])
    testthat::expect_equal(84, freqs[12, '1[count]'])
    testthat::expect_equal(32, freqs[12, '2[count]'])
})

testthat::test_that("conttables works with global integer weights", {
    suppressWarnings(RNGversion("3.5.0"))
    set.seed(212)

    rows <- factor(c("A","B","C","A","B","C","A","B","C","A","B","C"), c("A","B","C"))
    cols <- factor(c("1","1","1","2","2","2","1","1","1","2","2","2"), c("1","2"))
    layer <- factor(c("I","I","I","I","I","I","II","II","II","II","II","II"), c("I","II"))
    counts <- sample(0:20, 12, replace = TRUE)

    data <- data.frame(rows = rows, cols = cols, layer = layer)
    attr(data, "jmv-weights") <- counts

    table <- jmv::contTables(data=data, rows="rows", cols="cols", layers="layer")

    freqs <- as.data.frame(table$freqs)

    testthat::expect_equal(8, freqs[1, '1[count]'])
    testthat::expect_equal(3, freqs[1, '2[count]'])
    testthat::expect_equal(17, freqs[2, '1[count]'])
    testthat::expect_equal(0, freqs[2, '2[count]'])
    testthat::expect_equal(84, freqs[12, '1[count]'])
    testthat::expect_equal(32, freqs[12, '2[count]'])
})

testthat::test_that("bar plots work with spaces in variable name", {
    data <- ToothGrowth
    data$dose <- factor(data$dose)
    names(data) <- c("len", "su pp", "do se")

    table <- jmv::contTables(data=data, rows="su pp", cols="do se", barplot=TRUE)

    testthat::expect_true(table$barplot$.render())
})