From 363d10209f8fee991124665ae0cd6b969dc4848a Mon Sep 17 00:00:00 2001 From: Daniel Date: Tue, 1 Oct 2024 10:41:35 +0200 Subject: [PATCH 01/11] Update test based on glmmTMB fix --- DESCRIPTION | 1 + tests/testthat/test-r2.R | 17 ++++++++--------- 2 files changed, 9 insertions(+), 9 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index a6e2a3069..c2b5e65a5 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -160,3 +160,4 @@ Config/Needs/website: r-lib/pkgdown, easystats/easystatstemplate Config/rcmdcheck/ignore-inconsequential-notes: true +Remotes: glmmTMB/glmmTMB/glmmTMB#1102 diff --git a/tests/testthat/test-r2.R b/tests/testthat/test-r2.R index d7ade6b29..6b4ac0b05 100644 --- a/tests/testthat/test-r2.R +++ b/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), From 819f02207f5b4068a652f01524cbafe809298bfb Mon Sep 17 00:00:00 2001 From: Daniel Date: Tue, 1 Oct 2024 10:46:54 +0200 Subject: [PATCH 02/11] fix for insight --- R/performance_aicc.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/performance_aicc.R b/R/performance_aicc.R index 3c433161f..52cf3679c 100644 --- a/R/performance_aicc.R +++ b/R/performance_aicc.R @@ -265,7 +265,7 @@ performance_aicc.rma <- function(x, ...) { .adjust_ic_jacobian <- function(model, ic) { response_transform <- insight::find_transformation(model) if (!is.null(ic) && !is.null(response_transform) && !identical(response_transform, "identity")) { - adjustment <- .safe(.ll_analytic_adjustment(model, insight::get_weights(model, na_rm = TRUE))) + adjustment <- .safe(.ll_analytic_adjustment(model, insight::get_weights(model, remove_na = TRUE))) if (!is.null(adjustment)) { ic <- ic - 2 * adjustment } From 08ef3fb9ac774099eadab13f7d53edf2d39712f1 Mon Sep 17 00:00:00 2001 From: Daniel Date: Tue, 1 Oct 2024 10:53:07 +0200 Subject: [PATCH 03/11] change min version --- DESCRIPTION | 2 +- R/check_dag.R | 2 +- man/check_dag.Rd | 2 +- 3 files changed, 3 insertions(+), 3 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index c2b5e65a5..8680fd5b9 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -142,7 +142,7 @@ Suggests: rstanarm, rstantools, sandwich, - see (>= 0.8.2), + see (>= 0.9.0), survey, survival, testthat (>= 3.2.1), diff --git a/R/check_dag.R b/R/check_dag.R index 7a64ae4d0..53067cacf 100644 --- a/R/check_dag.R +++ b/R/check_dag.R @@ -111,7 +111,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, diff --git a/man/check_dag.Rd b/man/check_dag.Rd index fa7e92207..b65c732a8 100644 --- a/man/check_dag.Rd +++ b/man/check_dag.Rd @@ -137,7 +137,7 @@ adjustments or over-adjustment. } \examples{ -\dontshow{if (require("ggdag", quietly = TRUE) && require("dagitty", quietly = TRUE) && require("see", quietly = TRUE) && packageVersion("see") > "0.8.5") (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} +\dontshow{if (require("ggdag", quietly = TRUE) && require("dagitty", quietly = TRUE) && require("see", quietly = TRUE)) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} # no adjustment needed check_dag( y ~ x + b, From 062c42114e92902da6f8c3a9379bca0b1b323fd5 Mon Sep 17 00:00:00 2001 From: Daniel Date: Tue, 1 Oct 2024 10:54:49 +0200 Subject: [PATCH 04/11] update min versions --- R/check_heterogeneity_bias.R | 2 +- man/check_heterogeneity_bias.Rd | 2 +- tests/testthat/test-check_heterogeneity_bias.R | 1 - tests/testthat/test-icc.R | 1 - 4 files changed, 2 insertions(+), 4 deletions(-) diff --git a/R/check_heterogeneity_bias.R b/R/check_heterogeneity_bias.R index 3c9b502ce..27f604fd9 100644 --- a/R/check_heterogeneity_bias.R +++ b/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) +#' @examplesIf #' 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") diff --git a/man/check_heterogeneity_bias.Rd b/man/check_heterogeneity_bias.Rd index 228d26510..2f28a25a5 100644 --- a/man/check_heterogeneity_bias.Rd +++ b/man/check_heterogeneity_bias.Rd @@ -50,7 +50,7 @@ cause a heterogeneity bias, i.e. if variables have a within- and/or between-effect (\emph{Bell and Jones, 2015}). } \examples{ -\dontshow{if (insight::check_if_installed("datawizard", minimum_version = "0.12.0", quietly = TRUE)) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} +\dontshow{if () (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} 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") diff --git a/tests/testthat/test-check_heterogeneity_bias.R b/tests/testthat/test-check_heterogeneity_bias.R index e01ecf3ff..c3dfd95fe 100644 --- a/tests/testthat/test-check_heterogeneity_bias.R +++ b/tests/testthat/test-check_heterogeneity_bias.R @@ -1,5 +1,4 @@ test_that("check_heterogeneity_bias", { - skip_if_not_installed("datawizard", minimum_version = "0.12.0") data(iris) set.seed(123) iris$ID <- sample.int(4, nrow(iris), replace = TRUE) # fake-ID diff --git a/tests/testthat/test-icc.R b/tests/testthat/test-icc.R index 82da6a3eb..f362b3107 100644 --- a/tests/testthat/test-icc.R +++ b/tests/testthat/test-icc.R @@ -121,7 +121,6 @@ test_that("icc", { test_that("icc, glmmTMB 1.1.9+", { - skip_if_not_installed("glmmTMB", minimum_version = "1.1.9") set.seed(101) dd <- data.frame( z = rnorm(1000), From 764d5f0eafa98d3fe09bc6d1275f1f8dfa90fe92 Mon Sep 17 00:00:00 2001 From: Daniel Date: Tue, 1 Oct 2024 13:51:37 +0200 Subject: [PATCH 05/11] fix --- R/check_heterogeneity_bias.R | 2 +- man/check_heterogeneity_bias.Rd | 2 -- 2 files changed, 1 insertion(+), 3 deletions(-) diff --git a/R/check_heterogeneity_bias.R b/R/check_heterogeneity_bias.R index 27f604fd9..755f47dfa 100644 --- a/R/check_heterogeneity_bias.R +++ b/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 +#' @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") diff --git a/man/check_heterogeneity_bias.Rd b/man/check_heterogeneity_bias.Rd index 2f28a25a5..40b2b66ca 100644 --- a/man/check_heterogeneity_bias.Rd +++ b/man/check_heterogeneity_bias.Rd @@ -50,11 +50,9 @@ cause a heterogeneity bias, i.e. if variables have a within- and/or between-effect (\emph{Bell and Jones, 2015}). } \examples{ -\dontshow{if () (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} 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") -\dontshow{\}) # examplesIf} } \references{ \itemize{ From 41eafd260e1417d4bb4d2a30f1939e589deaf5e4 Mon Sep 17 00:00:00 2001 From: Daniel Date: Tue, 1 Oct 2024 14:11:45 +0200 Subject: [PATCH 06/11] fix --- tests/testthat/test-icc.R | 1 + 1 file changed, 1 insertion(+) diff --git a/tests/testthat/test-icc.R b/tests/testthat/test-icc.R index f362b3107..73f8b6e3f 100644 --- a/tests/testthat/test-icc.R +++ b/tests/testthat/test-icc.R @@ -121,6 +121,7 @@ test_that("icc", { test_that("icc, glmmTMB 1.1.9+", { + skip_if_not_installed("glmmTMB") set.seed(101) dd <- data.frame( z = rnorm(1000), From 1c75af94457a5f4213891427bfed8fb985770e90 Mon Sep 17 00:00:00 2001 From: Daniel Date: Tue, 1 Oct 2024 14:12:45 +0200 Subject: [PATCH 07/11] fix --- tests/testthat/test-check_heterogeneity_bias.R | 1 + 1 file changed, 1 insertion(+) diff --git a/tests/testthat/test-check_heterogeneity_bias.R b/tests/testthat/test-check_heterogeneity_bias.R index c3dfd95fe..9701a7c03 100644 --- a/tests/testthat/test-check_heterogeneity_bias.R +++ b/tests/testthat/test-check_heterogeneity_bias.R @@ -1,4 +1,5 @@ test_that("check_heterogeneity_bias", { + skip_if_not_installed("datawizard") data(iris) set.seed(123) iris$ID <- sample.int(4, nrow(iris), replace = TRUE) # fake-ID From 0dbc060c4e009047f3d09d86db26f6cccea60728 Mon Sep 17 00:00:00 2001 From: Daniel Date: Tue, 1 Oct 2024 15:50:36 +0200 Subject: [PATCH 08/11] docs, allow different coordinates --- R/check_dag.R | 62 +++++++++++++++++++++++++++++++++++++++++++++--- man/check_dag.Rd | 31 +++++++++++++++++++++--- 2 files changed, 87 insertions(+), 6 deletions(-) diff --git a/R/check_dag.R b/R/check_dag.R index 53067cacf..2b6739636 100644 --- a/R/check_dag.R +++ b/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()`. #' @@ -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, @@ -340,6 +367,35 @@ check_dag <- function(..., } +.process_coords <- function(coords) { + # check if the coords are not provided as list with x/y elements, but instead + # 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) + # ) + if (!is.null(coords) && (length(coords) != 2 || !identical(names(coords), c("x", "y")))) { + # transform list, so we split x and y coordinates. we now have all + # x- and y- coordinates in a separate row + out <- t(do.call(rbind, coords)) + # add back to list and name elements + coords <- list(out[1, ], out[2, ]) + names(coords) <- c("x", "y") + } + coords +} + + # methods -------------------------------------------------------------------- #' @rdname check_dag diff --git a/man/check_dag.Rd b/man/check_dag.Rd index b65c732a8..e366ff07a 100644 --- a/man/check_dag.Rd +++ b/man/check_dag.Rd @@ -42,9 +42,18 @@ are adjusted for in the model, e.g. \code{adjusted = c("x1", "x2")} or \item{effect}{Character string, indicating which effect to check. Can be \code{"all"} (default), \code{"total"}, or \code{"direct"}.} -\item{coords}{A list with two elements, \code{x} and \code{y}, which both are named -vectors of numerics. The names correspond to the variable names in the DAG, -and the values for \code{x} and \code{y} indicate the x/y coordinates in the plot. +\item{coords}{Coordinates of the variables when plotting the DAG. The +coordinates can be provided in three different ways: +\itemize{ +\item a list with two elements, \code{x} and \code{y}, which both are named vectors of +numerics. The names correspond to the variable names in the DAG, and the +values for \code{x} and \code{y} indicate the x/y coordinates in the plot. +\item 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. +\item a data frame with three columns: \code{x}, \code{y} and \code{name} (which contains the +variable names). +} + See 'Examples'.} \item{x}{An object of class \code{check_dag}, as returned by \code{check_dag()}.} @@ -197,6 +206,22 @@ dag <- check_dag( ) 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) From ce09540e0286d98b663d2e1645c73ebdc1895043 Mon Sep 17 00:00:00 2001 From: Daniel Date: Tue, 1 Oct 2024 15:57:12 +0200 Subject: [PATCH 09/11] simplify? --- R/check_dag.R | 13 +++++++------ 1 file changed, 7 insertions(+), 6 deletions(-) diff --git a/R/check_dag.R b/R/check_dag.R index 2b6739636..a654f2343 100644 --- a/R/check_dag.R +++ b/R/check_dag.R @@ -385,12 +385,13 @@ check_dag <- function(..., # y = c(score = 3, exp = 3, b = 2, c = 4) # ) if (!is.null(coords) && (length(coords) != 2 || !identical(names(coords), c("x", "y")))) { - # transform list, so we split x and y coordinates. we now have all - # x- and y- coordinates in a separate row - out <- t(do.call(rbind, coords)) - # add back to list and name elements - coords <- list(out[1, ], out[2, ]) - names(coords) <- c("x", "y") + # 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 } From 7c065debc08b1f8d88b889193193c09ad28d74c9 Mon Sep 17 00:00:00 2001 From: Daniel Date: Tue, 1 Oct 2024 22:09:06 +0200 Subject: [PATCH 10/11] fix --- R/check_dag.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/check_dag.R b/R/check_dag.R index a654f2343..9bc9bcd8c 100644 --- a/R/check_dag.R +++ b/R/check_dag.R @@ -369,7 +369,7 @@ check_dag <- function(..., .process_coords <- function(coords) { # check if the coords are not provided as list with x/y elements, but instead - # x/y coordinates for each element. This means, "coords" is provided as + # as list x/y coordinates for each element. This means, "coords" is provided as # # coords <- list( # score = c(5, 3), @@ -384,7 +384,7 @@ check_dag <- function(..., # x = c(score = 5, exp = 4, b = 3, c = 3), # y = c(score = 3, exp = 3, b = 2, c = 4) # ) - if (!is.null(coords) && (length(coords) != 2 || !identical(names(coords), c("x", "y")))) { + if (!is.null(coords) && !is.data.frame(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")), From 3831b8adc714dff14f51df5e3a9d5c60cdb14665 Mon Sep 17 00:00:00 2001 From: Daniel Date: Tue, 1 Oct 2024 22:49:02 +0200 Subject: [PATCH 11/11] fix --- R/check_dag.R | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/R/check_dag.R b/R/check_dag.R index 3d0ae3c2f..c8b53533f 100644 --- a/R/check_dag.R +++ b/R/check_dag.R @@ -382,7 +382,10 @@ check_dag <- function(..., # x = c(score = 5, exp = 4, b = 3, c = 3), # y = c(score = 3, exp = 3, b = 2, c = 4) # ) - if (!is.null(coords) && !is.data.frame(coords) && (length(coords) != 2 || !identical(names(coords), c("x", "y")))) { # nolint + # + # 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")),