contTablePaired: add note informing user of pairs being compared

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

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)."
+        )
+
+    )
+})