diff --git a/R/check_dag.R b/R/check_dag.R index 6ca03a6f2..90c176011 100644 --- a/R/check_dag.R +++ b/R/check_dag.R @@ -262,13 +262,22 @@ check_dag <- function(..., setdiff(ma, collider) }) } + # these are required. we make sure that both sets include the exposure + # so we can correctly compare required and current sets + all_required_adjustments <- sort(unique(c(exposure, adjustment_set))) + # this is what we have and which are allow + all_allowed_adjustments <- unique(setdiff(c(exposure, adjustment_nodes), collider)) list( - adjustment_not_needed = (is.null(adjustment_set) && is.null(adjustment_nodes) || - (identical(sort(unique(adjustment_set)), sort(unique(setdiff(c(exposure, adjustment_nodes), collider)))))) && - is.null(collider), - incorrectly_adjusted = (is.null(adjustment_set) && !is.null(adjustment_nodes)) || - (!identical(sort(unique(adjustment_set)), sort(unique(setdiff(c(exposure, adjustment_nodes), collider))))) || - (!is.null(collider) && collider %in% adjustment_nodes), + # no adjustment needed when + # - required and current adjustment sets are NULL + # - OR required and current adjustments are identical + # - AND we have no collider in current adjustments + adjustment_not_needed = ((is.null(adjustment_set) && is.null(adjustment_nodes)) || identical(all_required_adjustments, all_allowed_adjustments)) && is.null(collider), + # incorrect adjustment when + # - required is NULL and current adjustment not NULL + # - OR required and current adjustments are *not* identical + # - OR we have a collider in current adjustments + incorrectly_adjusted = (is.null(adjustment_set) && !is.null(adjustment_nodes)) || !identical(all_required_adjustments, all_allowed_adjustments) || (!is.null(collider) && collider %in% adjustment_nodes), current_adjustments = adjustment_nodes, minimal_adjustments = minimal_adjustments, collider = collider diff --git a/tests/testthat/_snaps/check_dag.md b/tests/testthat/_snaps/check_dag.md index a63da9ea0..88a4bee3b 100644 --- a/tests/testthat/_snaps/check_dag.md +++ b/tests/testthat/_snaps/check_dag.md @@ -88,8 +88,8 @@ Identification of direct and total effects - Model is correctly specified. - No adjustment needed to estimate the direct and total effect of `wt` on `mpg`. + Incorrectly adjusted! + To estimate the direct and total effect, do not adjust for `cyl`, `disp` and `gear`. # check_dag, multiple adjustment sets @@ -155,13 +155,13 @@ Identification of direct effects - Incorrectly adjusted! - To estimate the direct effect, do not adjust for `x1`. + Model is correctly specified. + No adjustment needed to estimate the direct effect of `exposure` on `outcome`. Identification of total effects - Incorrectly adjusted! - To estimate the total effect, do not adjust for `x1`. + Model is correctly specified. + No adjustment needed to estimate the total effect of `exposure` on `outcome`. --- @@ -176,13 +176,13 @@ Identification of direct effects - Incorrectly adjusted! - To estimate the direct effect, do not adjust for `x2`. + Model is correctly specified. + No adjustment needed to estimate the direct effect of `exposure` on `outcome`. Identification of total effects - Incorrectly adjusted! - To estimate the total effect, do not adjust for `x2`. + Model is correctly specified. + No adjustment needed to estimate the total effect of `exposure` on `outcome`. --- @@ -197,13 +197,13 @@ Identification of direct effects - Incorrectly adjusted! - To estimate the direct effect, do not adjust for `x1` and `x2`. + Model is correctly specified. + No adjustment needed to estimate the direct effect of `exposure` on `outcome`. Identification of total effects - Incorrectly adjusted! - To estimate the total effect, do not adjust for `x1` and `x2`. + Model is correctly specified. + No adjustment needed to estimate the total effect of `exposure` on `outcome`. # check_dag, collider bias