Update test based on glmmTMB fix

DESCRIPTION

@@ -142,7 +142,7 @@ Suggests:
     rstanarm,
     rstantools,
     sandwich,
-    see (>= 0.8.2),
+    see (>= 0.9.0),
     survey,
     survival,
     testthat (>= 3.2.1),
@@ -160,3 +160,4 @@ Config/Needs/website:
     r-lib/pkgdown,
     easystats/easystatstemplate
 Config/rcmdcheck/ignore-inconsequential-notes: true
+Remotes: glmmTMB/glmmTMB/glmmTMB#1102

R/check_dag.R

@@ -37,9 +37,17 @@
 #' @param latent A character vector with names of latent variables in the model.
 #' @param effect Character string, indicating which effect to check. Can be
 #' `"all"` (default), `"total"`, or `"direct"`.
-#' @param coords A list with two elements, `x` and `y`, which both are named
-#' vectors of numerics. The names correspond to the variable names in the DAG,
-#' and the values for `x` and `y` indicate the x/y coordinates in the plot.
+#' @param coords Coordinates of the variables when plotting the DAG. The
+#' coordinates can be provided in three different ways:
+#'
+#' - a list with two elements, `x` and `y`, which both are named vectors of
+#'   numerics. The names correspond to the variable names in the DAG, and the
+#'   values for `x` and `y` indicate the x/y coordinates in the plot.
+#' - a list with elements that correspond to the variables in the DAG. Each
+#'   element is a numeric vector of length two with x- and y-coordinate.
+#' - a data frame with three columns: `x`, `y` and `name` (which contains the
+#'   variable names).
+#'
 #' See 'Examples'.
 #' @param x An object of class `check_dag`, as returned by `check_dag()`.
 #'
@@ -111,7 +119,7 @@
 #'   Interpreting Confounder and Modifier Coefficients. American Journal of
 #'   Epidemiology, 177(4), 292–298. \doi{10.1093/aje/kws412}
 #'
-#' @examplesIf require("ggdag", quietly = TRUE) && require("dagitty", quietly = TRUE) && require("see", quietly = TRUE) && packageVersion("see") > "0.8.5"
+#' @examplesIf require("ggdag", quietly = TRUE) && require("dagitty", quietly = TRUE) && require("see", quietly = TRUE)
 #' # no adjustment needed
 #' check_dag(
 #'   y ~ x + b,
@@ -171,6 +179,22 @@
 #' )
 #' plot(dag)
 #'
+#' # alternative way of providing the coordinates
+#' dag <- check_dag(
+#'   score ~ exp + b + c,
+#'   exp ~ b,
+#'   outcome = "score",
+#'   exposure = "exp",
+#'   coords = list(
+#'     # x/y coordinates for each node
+#'     score = c(5, 3),
+#'     exp = c(4, 3),
+#'     b = c(3, 2),
+#'     c = c(3, 4)
+#'   )
+#' )
+#' plot(dag)
+#'
 #' # Objects returned by `check_dag()` can be used with "ggdag" or "dagitty"
 #' ggdag::ggdag_status(dag)
 #'
@@ -248,6 +272,9 @@ check_dag <- function(...,
     adjusted <- all.vars(adjusted)
   }
 
+  # process coords-argument
+  coords <- .process_coords(coords)
+
   # convert to dag
   dag_args <- c(formulas, list(
     exposure = exposure,
@@ -338,6 +365,39 @@ check_dag <- function(...,
 }
 
 
+.process_coords <- function(coords) {
+  # check if the coords are not provided as list with x/y elements, but instead
+  # as list x/y coordinates for each element. This means, "coords" is provided as
+  #
+  # coords <- list(
+  #   score = c(5, 3),
+  #   exp = c(4, 3),
+  #   b = c(3, 2),
+  #   c = c(3, 4)
+  # )
+  #
+  # but we want
+  #
+  # coords = list(
+  #   x = c(score = 5, exp = 4, b = 3, c = 3),
+  #   y = c(score = 3, exp = 3, b = 2, c = 4)
+  # )
+  #
+  # we have to check that it's not a data frame and that it is a list -
+  # values like `ggdag::time_ordered_coords()` returns a function, not a list
+  if (!is.null(coords) && !is.data.frame(coords) && is.list(coords) && (length(coords) != 2 || !identical(names(coords), c("x", "y")))) { # nolint
+    # transform list into data frame, split x and y coordinates into columns
+    coords <- datawizard::rownames_as_column(
+      stats::setNames(as.data.frame(do.call(rbind, coords)), c("x", "y")),
+      "name"
+    )
+    # reorder
+    coords <- coords[c("x", "y", "name")]
+  }
+  coords
+}
+
+
 # methods --------------------------------------------------------------------
 
 #' @rdname check_dag

R/check_heterogeneity_bias.R

@@ -39,7 +39,7 @@
 #'   Modeling of Time-Series Cross-Sectional and Panel Data. Political Science
 #'   Research and Methods, 3(1), 133–153.
 #'
-#' @examplesIf insight::check_if_installed("datawizard", minimum_version = "0.12.0", quietly = TRUE)
+#' @examples
 #' data(iris)
 #' iris$ID <- sample(1:4, nrow(iris), replace = TRUE) # fake-ID
 #' check_heterogeneity_bias(iris, select = c("Sepal.Length", "Petal.Length"), by = "ID")

tests/testthat/test-check_heterogeneity_bias.R

@@ -1,5 +1,5 @@
 test_that("check_heterogeneity_bias", {
-  skip_if_not_installed("datawizard", minimum_version = "0.12.0")
+  skip_if_not_installed("datawizard")
   data(iris)
   set.seed(123)
   iris$ID <- sample.int(4, nrow(iris), replace = TRUE) # fake-ID

tests/testthat/test-icc.R

@@ -121,7 +121,7 @@ test_that("icc", {
 
 
 test_that("icc, glmmTMB 1.1.9+", {
-  skip_if_not_installed("glmmTMB", minimum_version = "1.1.9")
+  skip_if_not_installed("glmmTMB")
   set.seed(101)
   dd <- data.frame(
     z = rnorm(1000),

tests/testthat/test-r2.R

@@ -79,6 +79,7 @@ withr::with_environment(
     out2 <- r2(m2)
     expect_equal(out[[1]], out2[[1]], tolerance = 1e-3, ignore_attr = TRUE)
     # zero-inflated --------------------------------------------------------------
+    skip_if_not(packageVersion("glmmTMB") > "1.1.10")
     skip_if_not_installed("pscl")
     data(bioChemists, package = "pscl")
     m <- glmmTMB::glmmTMB(
@@ -88,16 +89,14 @@ withr::with_environment(
       data = bioChemists
     )
     out <- r2(m)
-    expect_equal(out[[1]], 0.14943, tolerance = 1e-3, ignore_attr = TRUE)
-    ## FIXME: since glmmTMB 1.1.10(?) Pearson residuals differ and results
-    ## are no longer identical, see https://github.com/glmmTMB/glmmTMB/issues/1101
+    expect_equal(out[[1]], 0.1797549, tolerance = 1e-3, ignore_attr = TRUE)
     # validate against pscl::zeroinfl
-    # m2 <- pscl::zeroinfl(
-    #   art ~ fem + mar + kid5 + ment | kid5 + phd,
-    #   data = bioChemists
-    # )
-    # out2 <- r2(m2)
-    # expect_equal(out[[1]], out2[[1]], tolerance = 1e-3, ignore_attr = TRUE)
+    m2 <- pscl::zeroinfl(
+      art ~ fem + mar + kid5 + ment | kid5 + phd,
+      data = bioChemists
+    )
+    out2 <- r2(m2)
+    expect_equal(out[[1]], out2[[1]], tolerance = 1e-3, ignore_attr = TRUE)
     # Gamma --------------------------------------------------------------
     clotting <<- data.frame(
       u = c(5, 10, 15, 20, 30, 40, 60, 80, 100),