add tests

strengejacke · May 12, 2024 · 070d9df · 070d9df
1 parent 4b4e2fe
commit 070d9df
Show file tree

Hide file tree

Showing 7 changed files with 169 additions and 44 deletions.
diff --git a/R/kruskal_wallis_test.R b/R/kruskal_wallis_test.R
@@ -70,16 +70,16 @@ kruskal_wallis_test <- function(data,
     insight::format_error("At least two groups are required, i.e. data must have at least two unique levels in `by` for `kruskal_wallis_test()`.") # nolint
   }
   if (is.null(weights)) {
-    .calculate_kw(dv, grp)
+    .calculate_kw(dv, grp, group_labels = c(select, by))
   } else {
-    .calculate_weighted_kw(dv, grp, data[[weights]])
+    .calculate_weighted_kw(dv, grp, data[[weights]], group_labels = c(select, by))
   }
 }
 
 
 # Kruskal-Wallis-Test --------------------------------------------
 
-.calculate_kw <- function(dv, grp, paired = FALSE) {
+.calculate_kw <- function(dv, grp, paired = FALSE, group_labels = NULL) {
   # prepare data
   wcdat <- data.frame(dv, grp)
   if (paired) {
@@ -97,7 +97,7 @@ kruskal_wallis_test <- function(data,
   )
 
   out <- data.frame(
-    data = wt$data.name,
+    data = paste(group_labels[1], "by", group_labels[2]),
     Chi2 = wt$statistic,
     df = wt$parameter,
     p = as.numeric(wt$p.value),
@@ -115,7 +115,7 @@ kruskal_wallis_test <- function(data,
 
 # Weighted Mann-Whitney-Test for two groups ----------------------------------
 
-.calculate_weighted_kw <- function(dv, grp, weights, paired = FALSE) {
+.calculate_weighted_kw <- function(dv, grp, weights, paired = FALSE, group_labels = NULL) {
   # check if pkg survey is available
   insight::check_if_installed("survey")
 
@@ -135,7 +135,7 @@ kruskal_wallis_test <- function(data,
   }
 
   out <- data.frame(
-    data = paste(dv, "by", grp),
+    data = paste(group_labels[1], "by", group_labels[2]),
     Chi2 = result$statistic,
     df = result$parameter,
     p = as.numeric(result$p.value),

diff --git a/tests/testthat/_snaps/chi_squared_test.md b/tests/testthat/_snaps/chi_squared_test.md
@@ -0,0 +1,66 @@
+# chi_squared_test
+
+    Code
+      print(out1)
+    Output
+      
+      # Chi-squared test for contingency tables
+      
+        Data: c161sex by e16sex (n = 900)
+      
+        χ² = 2.233, ϕ = 0.053, df = 1, p = 0.135
+      
+
+---
+
+    Code
+      print(out)
+    Output
+      
+      # Chi-squared test for contingency tables (weighted)
+      
+        Data: c161sex by e16sex (n = 904)
+      
+        χ² = 2.416, ϕ = 0.054, df = 1, p = 0.120
+      
+
+---
+
+    Code
+      print(out1)
+    Output
+      
+      # Chi-squared test for given probabilities
+      
+        Data: c161sex against probabilities 30% and 70% (n = 901)
+      
+        χ² = 16.162, פ‎ = 0.088, df = 1, p < .001
+      
+
+---
+
+    Code
+      print(out)
+    Output
+      
+      # Chi-squared test for given probabilities (weighted)
+      
+        Data: c161sex against probabilities 30% and 70% (n = 906)
+      
+        χ² = 20.074, פ‎ = 0.097, df = 1, p < .001
+      
+
+---
+
+    Code
+      print(out1)
+    Output
+      
+      # Chi-squared test for contingency tables
+        (using McNemar's test for paired data)
+      
+        Data: survey_1 by survey_2 (n = 1000)
+      
+        χ² = 10.868, ϕ = 0.032, df = 1, p < .001
+      
+
diff --git a/tests/testthat/_snaps/kruskal_wallis_test.md b/tests/testthat/_snaps/kruskal_wallis_test.md
@@ -0,0 +1,24 @@
+# kruskal_wallis_test
+
+    Code
+      print(out1)
+    Output
+      # Kruskal-Wallis test
+      
+        Data: e17age by c172code (3 groups, n = 506, 180 and 156)
+      
+        χ² = 4.05, df = 2, p = 0.132
+      
+
+---
+
+    Code
+      print(out1)
+    Output
+      # Kruskal-Wallis test
+      
+        Data: scale1 by scale2 (3 groups, n = 20, 20 and 20)
+      
+        χ² = 4.86, df = 2, p = 0.088
+      
+
diff --git a/tests/testthat/_snaps/mann_whitney_test.md b/tests/testthat/_snaps/mann_whitney_test.md
@@ -0,0 +1,41 @@
+# mann_whitney_test
+
+    Code
+      print(out1)
+    Output
+      # Mann-Whitney test
+      
+        Group 1: male   (n = 294, rank mean = 147.50)
+        Group 2: female (n = 596, rank mean = 298.50)
+        Alternative hypothesis: true location shift is not equal to 0
+      
+        W = 59684 , r = 0.26, Z = -7.75, p < .001
+      
+
+---
+
+    Code
+      print(out1)
+    Output
+      # Mann-Whitney test
+      
+        Group 1: scale1 (n = 20, rank mean = 10.50)
+        Group 2: scale2 (n = 20, rank mean = 10.50)
+        Alternative hypothesis: true location shift is not equal to 0
+      
+        W = 188 , r = 0.05, Z = -0.32, p = 0.758
+      
+
+---
+
+    Code
+      print(out)
+    Output
+      # Mann-Whitney test (weighted)
+      
+        Group 1: male   (n = 296, rank mean = 147.58)
+        Group 2: female (n = 600, rank mean = 299.42)
+      
+        r = 0.26, Z = 7.78, p < .001
+      
+
diff --git a/tests/testthat/test-chi_squared_test.R b/tests/testthat/test-chi_squared_test.R
@@ -9,20 +9,24 @@ test_that("chi_squared_test", {
   out2 <- chisq.test(efc$c161sex, efc$e16sex)
   expect_equal(out1$statistic, out2$statistic, tolerance = 1e-4, ignore_attr = TRUE)
   expect_equal(out1$p, out2$p.value, tolerance = 1e-4, ignore_attr = TRUE)
+  expect_snapshot(print(out1))
 
   out <- chi_squared_test(efc, "c161sex", by = "e16sex", weights = "weight")
   expect_equal(out$statistic, 2.415755, tolerance = 1e-4, ignore_attr = TRUE)
   expect_equal(out$effect_size, 0.05448519, tolerance = 1e-4, ignore_attr = TRUE)
   expect_equal(out$p, 0.1201201, tolerance = 1e-4, ignore_attr = TRUE)
+  expect_snapshot(print(out))
 
   out1 <- chi_squared_test(efc, "c161sex", probabilities = c(0.3, 0.7))
   out2 <- chisq.test(table(efc$c161sex), p = c(0.3, 0.7))
   expect_equal(out1$statistic, out2$statistic, tolerance = 1e-4, ignore_attr = TRUE)
   expect_equal(out1$p, out2$p.value, tolerance = 1e-4, ignore_attr = TRUE)
+  expect_snapshot(print(out1))
 
   out <- chi_squared_test(efc, "c161sex", probabilities = c(0.3, 0.7), weights = "weight")
   expect_equal(out$statistic, 20.07379, tolerance = 1e-4, ignore_attr = TRUE)
   expect_equal(out$effect_size, 0.0974456, tolerance = 1e-4, ignore_attr = TRUE)
+  expect_snapshot(print(out))
 
   set.seed(1234)
   d <- data.frame(
@@ -34,4 +38,5 @@ test_that("chi_squared_test", {
   expect_equal(out1$statistic, out2$statistic, tolerance = 1e-4, ignore_attr = TRUE)
   expect_equal(out1$p, out2$p.value, tolerance = 1e-4, ignore_attr = TRUE)
   expect_equal(out1$effect_size, 0.03170437, tolerance = 1e-4, ignore_attr = TRUE)
+  expect_snapshot(print(out1))
 })
diff --git a/tests/testthat/test-kruskal_wallis_test.R b/tests/testthat/test-kruskal_wallis_test.R
@@ -2,48 +2,34 @@ skip_if_not_installed("survey")
 skip_if_not_installed("datawizard")
 
 test_that("kruskal_wallis_test", {
-#' data(efc)
-#' # Kruskal-Wallis test for elder's age by education
-#' kruskal_wallis_test(efc, "e17age", by = "c172code")
-#'
-#' # when data is in wide-format, specify all relevant continuous
-#' # variables in `select` and omit `by`
-#' set.seed(123)
-#' wide_data <- data.frame(
-#'   scale1 = runif(20),
-#'   scale2 = runif(20),
-#'   scale3 = runif(20)
-#' )
-#' kruskal_wallis_test(wide_data, select = c("scale1", "scale2", "scale3"))
-#'
-#' # same as if we had data in long format, with grouping variable
-#' long_data <- data.frame(
-#'   scales = c(wide_data$scale1, wide_data$scale2, wide_data$scale3),
-#'   groups = rep(c("A", "B", "C"), each = 20)
-#' )
-#' kruskal_wallis_test(long_data, select = "scales", by = "groups")
-#' # base R equivalent
-#' kruskal.test(scales ~ groups, data = long_data)
   data(efc)
   set.seed(123)
   efc$weight <- abs(rnorm(nrow(efc), 1, 0.3))
-  out1 <- mann_whitney_test(efc, "e17age", by = "e16sex")
-  out2 <- wilcox.test(e17age ~ e16sex, data = efc)
-  expect_equal(out1$w, out2$statistic, tolerance = 1e-4, ignore_attr = TRUE)
+  out1 <- kruskal_wallis_test(efc, "e17age", by = "c172code")
+  out2 <- kruskal.test(e17age ~ c172code, data = efc)
+  expect_equal(out1$Chi2, out2$statistic, tolerance = 1e-4, ignore_attr = TRUE)
   expect_equal(out1$p, out2$p.value, tolerance = 1e-4, ignore_attr = TRUE)
-  expect_equal(out1$estimate, -1561, tolerance = 1e-4, ignore_attr = TRUE)
-  expect_equal(out1$r, 0.2571254, tolerance = 1e-4, ignore_attr = TRUE)
+  expect_snapshot(print(out1))
 
   set.seed(123)
-  wide_data <- data.frame(scale1 = runif(20), scale2 = runif(20))
-  out1 <- mann_whitney_test(wide_data, select = c("scale1", "scale2"))
-  out2 <- wilcox.test(wide_data$scale1, wide_data$scale2)
-  expect_equal(out1$w, out2$statistic, tolerance = 1e-4, ignore_attr = TRUE)
-  expect_equal(out1$p, out2$p.value, tolerance = 1e-4, ignore_attr = TRUE)
-  expect_equal(out1$r, 0.05132394, tolerance = 1e-4, ignore_attr = TRUE)
+  wide_data <- data.frame(
+    scale1 = runif(20),
+    scale2 = runif(20),
+    scale3 = runif(20)
+  )
+  long_data <- data.frame(
+    scales = c(wide_data$scale1, wide_data$scale2, wide_data$scale3),
+    groups = as.factor(rep(c("A", "B", "C"), each = 20)),
+    stringsAsFactors = FALSE
+  )
+  out1 <- kruskal_wallis_test(wide_data, select = c("scale1", "scale2", "scale3"))
+  out2 <- kruskal_wallis_test(long_data, select = "scales", by = "groups")
+  out3 <- kruskal.test(scales ~ groups, data = long_data)
+  expect_equal(out1$Chi2, out2$Chi2, tolerance = 1e-4, ignore_attr = TRUE)
+  expect_equal(out1$Chi2, out3$statistic, tolerance = 1e-4, ignore_attr = TRUE)
+  expect_equal(out1$p, out2$p, tolerance = 1e-4, ignore_attr = TRUE)
+  expect_equal(out1$p, out3$p.value, tolerance = 1e-4, ignore_attr = TRUE)
+  expect_snapshot(print(out1))
 
-  out <- mann_whitney_test(efc, "e17age", by = "e16sex", weights = "weight")
-  expect_equal(out$p, 1.976729e-14, tolerance = 1e-4, ignore_attr = TRUE)
-  expect_equal(out$estimate, 0.1594972, tolerance = 1e-4, ignore_attr = TRUE)
-  expect_equal(out$r, 0.2599877, tolerance = 1e-4, ignore_attr = TRUE)
+  out1 <- kruskal_wallis_test(efc, "e17age", by = "c172code", weights = "weight")
 })
diff --git a/tests/testthat/test-mann_whitney_test.R b/tests/testthat/test-mann_whitney_test.R
@@ -10,8 +10,9 @@ test_that("mann_whitney_test", {
   out2 <- wilcox.test(e17age ~ e16sex, data = efc)
   expect_equal(out1$w, out2$statistic, tolerance = 1e-4, ignore_attr = TRUE)
   expect_equal(out1$p, out2$p.value, tolerance = 1e-4, ignore_attr = TRUE)
-  expect_equal(out1$estimate, -1561, tolerance = 1e-4, ignore_attr = TRUE)
+  expect_equal(out1$estimate, -151, tolerance = 1e-4, ignore_attr = TRUE)
   expect_equal(out1$r, 0.2571254, tolerance = 1e-4, ignore_attr = TRUE)
+  expect_snapshot(print(out1))
 
   set.seed(123)
   wide_data <- data.frame(scale1 = runif(20), scale2 = runif(20))
@@ -20,11 +21,13 @@ test_that("mann_whitney_test", {
   expect_equal(out1$w, out2$statistic, tolerance = 1e-4, ignore_attr = TRUE)
   expect_equal(out1$p, out2$p.value, tolerance = 1e-4, ignore_attr = TRUE)
   expect_equal(out1$r, 0.05132394, tolerance = 1e-4, ignore_attr = TRUE)
+  expect_snapshot(print(out1))
 
   out <- mann_whitney_test(efc, "e17age", by = "e16sex", weights = "weight")
   expect_equal(out$p, 1.976729e-14, tolerance = 1e-4, ignore_attr = TRUE)
   expect_equal(out$estimate, 0.1594972, tolerance = 1e-4, ignore_attr = TRUE)
   expect_equal(out$r, 0.2599877, tolerance = 1e-4, ignore_attr = TRUE)
+  expect_snapshot(print(out))
 })
 
 test_that("mann_whitney_test, sanity checks", {