diff --git a/R/conttablespaired.b.R b/R/conttablespaired.b.R index f87e9734..3df7a3b2 100644 --- a/R/conttablespaired.b.R +++ b/R/conttablespaired.b.R @@ -280,6 +280,9 @@ contTablesPairedClass <- R6::R6Class( test <- self$results$get('test') test$addRow(rowKey=1, values=list()) + note <- private$.getPairsNote(data, rowVarName, colVarName) + if ( ! is.null(note)) + test$setNote('pairs', note) }, .grid=function(data, incRows=FALSE) { @@ -307,5 +310,28 @@ contTablesPairedClass <- R6::R6Class( if (is.null(self$options$rows) || is.null(self$options$cols)) return('~') jmvcore:::composeFormula(self$options$counts, list(list(self$options$rows, self$options$cols))) - }) + }, + .getPairsNote = function(data, rowVarName, colVarName) { + if (is.null(rowVarName) || is.null(colVarName)) + return() + + rowLevels <- levels(data[[rowVarName]]) + colLevels <- levels(data[[colVarName]]) + + if (length(rowLevels) != 2 || length(colLevels) != 2) + return() + + note <- jmvcore::format( + .("McNemar's test evaluates the difference in counts between pairs changing from ({rowLevel1} in {rowVarName} \u2192 {rowLevel2} in {colVarName}) and pairs changing from ({rowLevel2} in {rowVarName} \u2192 {rowLevel1} in {colVarName})."), + rowVarName=rowVarName, + colVarName=colVarName, + rowLevel1=rowLevels[1], + colLevel1=colLevels[1], + rowLevel2=rowLevels[2], + colLevel2=colLevels[2] + ) + + return(note) + } + ) ) diff --git a/tests/testthat/testconttablespaired.R b/tests/testthat/testconttablespaired.R index 89e44167..a2c84515 100644 --- a/tests/testthat/testconttablespaired.R +++ b/tests/testthat/testconttablespaired.R @@ -50,3 +50,27 @@ testthat::test_that('All options in the contTablesPaired work (sunny)', { testthat::expect_equal(0, testTable[['p[exa]']], tolerance = 1e-3) testthat::expect_equal(1600, testTable[['value[n]']]) }) + +testthat::test_that('Test table contains footnote with info on the pairs that are used', { + # GIVEN a data set with paired counts data + df <- data.frame( + session_1 = c("condition_1", "condition_1", "condition_2", "condition_2"), + session_2 = c("condition_1", "condition_2", "condition_1", "condition_2"), + counts = c(5, 5, 5, 5) + ) + + # WHEN I run a paired contingency table + r <- jmv::contTablesPaired(df, rows = 'session_1', cols = 'session_2', counts = 'counts') + + # THEN the test table should contain the correct message + note <- r$test$notes$pairs$note + testthat::expect_equal( + note, + paste0( + "McNemar's test evaluates the difference in counts between pairs changing from", + " (condition_1 in session_1 \u2192 condition_2 in session_2) and pairs changing from", + " (condition_2 in session_1 \u2192 condition_1 in session_2)." + ) + + ) +})