Skip to content

Commit

Permalink
Browse files Browse the repository at this point in the history
  • Loading branch information
strengejacke committed Oct 1, 2024
2 parents 8d5742e + c5a2229 commit 4faff5a
Show file tree
Hide file tree
Showing 8 changed files with 106 additions and 23 deletions.
3 changes: 2 additions & 1 deletion DESCRIPTION
Original file line number Diff line number Diff line change
Expand Up @@ -142,7 +142,7 @@ Suggests:
rstanarm,
rstantools,
sandwich,
see (>= 0.8.2),
see (>= 0.9.0),
survey,
survival,
testthat (>= 3.2.1),
Expand All @@ -160,3 +160,4 @@ Config/Needs/website:
r-lib/pkgdown,
easystats/easystatstemplate
Config/rcmdcheck/ignore-inconsequential-notes: true
Remotes: glmmTMB/glmmTMB/glmmTMB#1102
68 changes: 64 additions & 4 deletions R/check_dag.R
Original file line number Diff line number Diff line change
Expand Up @@ -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()`.
#'
Expand Down Expand Up @@ -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,
Expand Down Expand Up @@ -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)
#'
Expand Down Expand Up @@ -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,
Expand Down Expand Up @@ -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
Expand Down
2 changes: 1 addition & 1 deletion R/check_heterogeneity_bias.R
Original file line number Diff line number Diff line change
Expand Up @@ -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")
Expand Down
33 changes: 29 additions & 4 deletions man/check_dag.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

2 changes: 0 additions & 2 deletions man/check_heterogeneity_bias.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

2 changes: 1 addition & 1 deletion tests/testthat/test-check_heterogeneity_bias.R
Original file line number Diff line number Diff line change
@@ -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
Expand Down
2 changes: 1 addition & 1 deletion tests/testthat/test-icc.R
Original file line number Diff line number Diff line change
Expand Up @@ -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),
Expand Down
17 changes: 8 additions & 9 deletions tests/testthat/test-r2.R
Original file line number Diff line number Diff line change
Expand Up @@ -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(
Expand All @@ -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),
Expand Down

0 comments on commit 4faff5a

Please sign in to comment.