From a52d2951a2e0d5d67ab36c45dcbb09f9e95c0aa8 Mon Sep 17 00:00:00 2001
From: Daniel <mail@danielluedecke.de>
Date: Fri, 13 Sep 2024 14:16:31 +0200
Subject: [PATCH] fix

---
 R/check_dag.R                      | 21 +++++++++++++++------
 tests/testthat/_snaps/check_dag.md | 28 ++++++++++++++--------------
 2 files changed, 29 insertions(+), 20 deletions(-)

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