see #812

Author: mattansb

R/check_group_variation.R

@@ -50,17 +50,15 @@
 #' These variables can have one of the following three labels:
 #' - _between_ - the variable is fixed (has exactly one unique, constant value)
 #'   for each group.
+#' - _nested_ - the variable vary within each group, with each group having
+#'   their own set of unique levels of the variable.
 #' - _within_ - the variable is _crossed_ with the grouping variable - each
 #'   value appear within each group. The `tolerance_factor` argument controls if
 #'   full balance is also required.
 #' - _both_ - the variable is partially nested within the grouping variable (or,
 #'   when `tolerance_factor = "balanced"` the variable is fully crossed, but not
 #'   perfectly balanced).
 #'
-#' Additionally, if variables are nested within the groups (i.e. variables vary
-#' within each group indicated in `by`, with each group having their own set of
-#' unique levels of the variable), a _nested_ label is added,
-#'
 #' ## Heterogeneity bias
 #' Variables that vary both within and between groups can cause a heterogeneity
 #' bias (_Bell and Jones, 2015_). It is recommended to center (person-mean
@@ -271,6 +269,7 @@ summary.check_group_variation <- function(x, ...) {
       "green"
     ))
   }
+  invisible(result)
 }
 
 
@@ -329,7 +328,13 @@ summary.check_group_variation <- function(x, ...) {
   complete <- stats::complete.cases(group, variable)
   group <- droplevels(as.factor(group[complete]))
   variable <- variable[complete]
-  nested <- FALSE
+
+  # Is the variable fixed for each group?
+  n_uniques <- tapply(variable, group, insight::n_unique)
+  is_between <- all(n_uniques == 1L)
+  if (is_between) {
+    return("between")
+  }
 
   # Is the variable nested within each group?
   if (insight::check_if_installed("Matrix", reason = "for checking nested designs")) {
@@ -345,40 +350,33 @@ summary.check_group_variation <- function(x, ...) {
       "CsparseMatrix"
     )
     if (all(sm@p[2:(k + 1L)] - sm@p[1:k] <= 1L)) {
-      nested <- TRUE
+      return("nested")
     }
   }
 
-  # Is the variable fixed for each group?
-  n_uniques <- tapply(variable, group, insight::n_unique)
-  is_between <- all(n_uniques == 1L)
-  if (is_between) {
-    return(ifelse(nested, "between (nested)", "between"))
-  }
-
   # If each group has a different number of unique values,
   # then it is partially nested/crossed.
   if (!insight::has_single_value(n_uniques)) {
-    return(ifelse(nested, "both (nested)", "both"))
+    return("both")
   }
 
   # Is the variable crossed?
   variable_levels <- unique(variable)
   has_all <- tapply(variable, group, function(v) all(variable_levels %in% v))
   if (!all(has_all)) {
-    return(ifelse(nested, "both (nested)", "both"))
+    return("both")
   }
 
   if (tolerance_factor == "crossed") {
-    return(ifelse(nested, "within (nested)", "within"))
+    return("within")
   }
 
   # Is the variable crossed and balanced?
   tab <- table(variable, group)
   is_balanced <- all(apply(tab, 2, insight::has_single_value))
-  if (!is_balanced) {
-    return(ifelse(nested, "both (nested)", "both"))
+  if (is_balanced) {
+    return("within")
   }
 
-  ifelse(nested, "within (nested)", "within")
+  return("both")
 }

man/check_group_variation.Rd

@@ -1,35 +1,25 @@
 test_that("check_group_variation-1", {
-  skip_if_not_installed("lme4")
-  set.seed(11)
+
   group <- rep(LETTERS[1:3], each = 3)
   variable1 <- rep(letters[1:3], each = 3)
+  variable1b <- rep(letters[1:2], times = c(6, 3))
   variable2 <- rep(letters[1:3], times = 3)
   variable3 <- letters[1:9]
   variable4 <- c(letters[1:5], letters[1:4])
 
-  d <- data.frame(group, variable1, variable2, variable3, variable4)
+  d <- data.frame(group, variable1, variable1b, variable2, variable3, variable4)
   out <- check_group_variation(d, by = "group")
 
-  out2 <- c(
-    variable1 = lme4::isNested(variable1, group),
-    variable2 = lme4::isNested(variable2, group),
-    variable3 = lme4::isNested(variable3, group),
-    variable4 = lme4::isNested(variable4, group)
-  )
   expect_equal(
     out,
     data.frame(
-      group = c("group", "group", "group", "group"),
-      variable = c("variable1", "variable2", "variable3", "variable4"),
-      type = c("between (nested)", "within", "both (nested)", "both")
+      group = c("group", "group", "group", "group", "group"),
+      variable = c("variable1", "variable1b", "variable2", "variable3", "variable4"),
+      type = c("between", "between", "within", "nested", "both")
     ),
     ignore_attr = TRUE
   )
-  expect_equal(
-    endsWith(out$type, "(nested)"),
-    out2,
-    ignore_attr = TRUE
-  )
+
 
   set.seed(111)
   dat <- data.frame(
@@ -59,7 +49,7 @@ test_that("check_group_variation-1", {
     data.frame(
       group = c("id", "id", "id", "id", "id", "id"),
       variable = c("between_num", "within_num", "both_num", "between_fac", "within_fac", "both_fac"),
-      type = c("between", "within", "both", "between (nested)", "within", "both")
+      type = c("between", "within", "both", "between", "within", "both")
     ),
     ignore_attr = TRUE
   )
@@ -161,7 +151,7 @@ test_that("check_group_variation, multiple by", {
     data.frame(
       group = c("schoolid", "schoolid", "schoolid", "schoolid", "childid", "childid", "childid", "childid"),
       variable = c("lowinc", "female", "year", "math", "lowinc", "female", "year", "math"),
-      type = c("between (nested)", "both", "within", "both", "between", "between", "within", "both")
+      type = c("between", "both", "within", "both", "between", "between", "within", "both")
     ),
     ignore_attr = TRUE
   )
@@ -179,7 +169,7 @@ test_that("check_group_variation, multiple by", {
         "schoolid", "lowinc", "female", "year", "math"
       ),
       type = c(
-        "both (nested)", "between (nested)", "both", "within", "both",
+        "nested", "between", "both", "within", "both",
         "between", "between", "between", "within", "both"
       )
     ),
@@ -239,10 +229,10 @@ test_that("check_group_variation, numeric_as_factor", {
   )
   expect_identical(
     out1$type,
-    c("between (nested)", "both", "within", "both", "between", "between", "within", "both")
+    c("between", "both", "within", "both", "between", "between", "within", "both")
   )
   expect_identical(
     out2$type,
-    c("between (nested)", "both", "within", "both (nested)", "between", "between", "within", "both")
+    c("between", "both", "within", "nested", "between", "between", "within", "both")
   )
 })