Ptint DAG result only once if identical (#763)

easystats · Aug 11, 2024 · 7d010cc · 7d010cc
1 parent 6913001
commit 7d010cc
Show file tree

Hide file tree

Showing 4 changed files with 109 additions and 145 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,7 +1,7 @@
 Type: Package
 Package: performance
 Title: Assessment of Regression Models Performance
-Version: 0.12.2.9
+Version: 0.12.2.10
 Authors@R:
     c(person(given = "Daniel",
              family = "Lüdecke",

diff --git a/R/check_dag.R b/R/check_dag.R
@@ -66,6 +66,7 @@
 #' to remove cycles from the model.
 #'
 #' @section Direct and total effects:
+#'
 #' The direct effect of an exposure on an outcome is the effect that is not
 #' mediated by any other variable in the model. The total effect is the sum of
 #' the direct and indirect effects. The function checks if the model is correctly
@@ -316,101 +317,111 @@ print.check_dag <- function(x, ...) {
   cat(exposure_outcome_text)
   cat("\n\n")
 
-  for (i in c("direct", "total")) {
-    if (i == "direct") {
-      out <- attributes(x)$check_direct
-    } else {
-      out <- attributes(x)$check_total
+  # minimal adjustment sets for direct and total effect identical?
+  # Then print only once
+  if (identical(attributes(x)$check_direct$minimal_adjustments, attributes(x)$check_total$minimal_adjustments)) {
+    .print_dag_results(attributes(x)$check_direct, x, "direct and total", "all")
+  } else {
+    for (i in c("direct", "total")) {
+      if (i == "direct") {
+        out <- attributes(x)$check_direct
+      } else {
+        out <- attributes(x)$check_total
+      }
+      .print_dag_results(out, x, i, effect)
     }
+  }
+}
 
-    # missing adjustements - minimal_adjustment can be a list of different
-    # options for minimal adjustements, so we check here if any of the minimal
-    # adjustements are currently sufficient
-    missing_adjustments <- vapply(out$minimal_adjustments, function(i) {
-      !is.null(out$current_adjustments) && all(i %in% out$current_adjustments)
-    }, logical(1))
-
-    # build message with check results for effects -----------------------
-
-    if (isTRUE(out$adjustment_not_needed)) {
-      # Scenario 1: no adjustment needed
-      msg <- paste0(
-        insight::color_text("Model is correctly specified.", "green"),
-        "\nNo adjustment needed to estimate the ", i, " effect of ",
-        datawizard::text_concatenate(attributes(x)$exposure, enclose = "`"),
-        " on `",
-        attributes(x)$outcome,
-        "`."
-      )
-    } else if (isTRUE(out$incorrectly_adjusted)) {
-      # Scenario 2: incorrectly adjusted, adjustments where none is allowed
+.print_dag_results <- function(out, x, i, effect) {
+  # missing adjustements - minimal_adjustment can be a list of different
+  # options for minimal adjustements, so we check here if any of the minimal
+  # adjustments are currently sufficient
+  sufficient_adjustments <- vapply(out$minimal_adjustments, function(min_adj) {
+    !is.null(out$current_adjustments) && all(min_adj %in% out$current_adjustments)
+  }, logical(1))
+
+  # build message with check results for effects -----------------------
+
+  if (isTRUE(out$adjustment_not_needed)) {
+    # Scenario 1: no adjustment needed
+    msg <- paste0(
+      insight::color_text("Model is correctly specified.", "green"),
+      "\nNo adjustment needed to estimate the ", i, " effect of ",
+      datawizard::text_concatenate(attributes(x)$exposure, enclose = "`"),
+      " on `",
+      attributes(x)$outcome,
+      "`."
+    )
+  } else if (isTRUE(out$incorrectly_adjusted)) {
+    # Scenario 2: incorrectly adjusted, adjustments where none is allowed
+    msg <- paste0(
+      insight::color_text("Incorrectly adjusted!", "red"),
+      "\nTo estimate the ", i, " effect, do ",
+      insight::color_text("not", "italic"),
+      " adjust for ",
+      datawizard::text_concatenate(out$current_adjustments, enclose = "`"),
+      "."
+    )
+  } else if (any(sufficient_adjustments)) {
+    # Scenario 3: correct adjustment
+    msg <- paste0(
+      insight::color_text("Model is correctly specified.", "green"),
+      "\nAll minimal sufficient adjustments to estimate the ", i, " effect were done."
+    )
+  } else {
+    # Scenario 4: missing adjustments
+    msg <- paste0(
+      insight::color_text("Incorrectly adjusted!", "red"),
+      "\nTo estimate the ", i, " effect, ",
+      insight::color_text("at least", "italic"),
+      " adjust for "
+    )
+    # we may have multiple valid adjustment sets - handle this here
+    if (length(out$minimal_adjustments) > 1) {
       msg <- paste0(
-        insight::color_text("Incorrectly adjusted!", "red"),
-        "\nTo estimate the ", i, " effect, do ",
-        insight::color_text("not", "italic"),
-        " adjust for ",
-        datawizard::text_concatenate(out$current_adjustments, enclose = "`"),
+        msg,
+        "one of the following sets:\n",
+        insight::color_text(
+          paste(
+            "-",
+            unlist(lapply(out$minimal_adjustments, paste, collapse = ", "), use.names = FALSE),
+            collapse = "\n"
+          ),
+          "yellow"
+        ),
         "."
       )
-    } else if (!any(missing_adjustments)) { # nolint
-      # Scenario 3: missing adjustments
+    } else {
       msg <- paste0(
-        insight::color_text("Incorrectly adjusted!", "red"),
-        "\nTo estimate the ", i, " effect, ",
-        insight::color_text("also", "italic"),
-        " adjust for "
+        msg,
+        insight::color_text(datawizard::text_concatenate(
+          unlist(out$minimal_adjustments, use.names = FALSE),
+          enclose = "`"
+        ), "yellow"),
+        "."
       )
-      # we may have multiple valid adjustment sets - handle this here
-      if (length(out$minimal_adjustments) > 1) {
-        msg <- paste0(
-          msg,
-          "one of the following sets:\n",
-          insight::color_text(
-            paste(
-              "-",
-              unlist(lapply(out$minimal_adjustments, paste, collapse = ", "), use.names = FALSE),
-              collapse = "\n"
-            ),
-            "yellow"
-          ),
-          "."
-        )
-      } else {
-        msg <- paste0(
-          msg,
-          insight::color_text(datawizard::text_concatenate(
-            unlist(out$minimal_adjustments, use.names = FALSE),
-            enclose = "`"
-          ), "yellow"),
-          "."
-        )
-      }
-      if (is.null(out$current_adjustments)) {
-        msg <- paste0(msg, "\nCurrently, the model does not adjust for any variables.")
-      } else {
-        msg <- paste0(
-          msg, "\nCurrently, the model only adjusts for ",
-          insight::color_text(datawizard::text_concatenate(out$current_adjustments, enclose = "`"), "yellow"), "."
-        )
-      }
+    }
+    if (is.null(out$current_adjustments)) {
+      msg <- paste0(msg, "\nCurrently, the model does not adjust for any variables.")
     } else {
-      # Scenario 4: correct adjustment
       msg <- paste0(
-        insight::color_text("Model is correctly specified.", "green"),
-        "\nAll minimal sufficient adjustments to estimate the ", i, " effect were done."
+        msg, "\nCurrently, the model only adjusts for ",
+        insight::color_text(datawizard::text_concatenate(out$current_adjustments, enclose = "`"), "yellow"), "."
       )
     }
+  }
 
-    if (effect %in% c("all", i)) {
-      cat(insight::print_color(insight::format_message(
-        paste0("Identification of {.i ", i, "} effects\n\n")
-      ), "blue"))
-      cat(msg)
-      cat("\n\n")
-    }
+  if (effect %in% c("all", i)) {
+    cat(insight::print_color(insight::format_message(
+      paste0("Identification of ", i, " effects\n\n")
+    ), "blue"))
+    cat(msg)
+    cat("\n\n")
   }
 }
 
+
 #' @export
 plot.check_dag <- function(x, ...) {
   insight::check_if_installed("see", "to plot DAG")

diff --git a/man/check_dag.Rd b/man/check_dag.Rd
diff --git a/tests/testthat/_snaps/check_dag.md b/tests/testthat/_snaps/check_dag.md
@@ -7,15 +7,10 @@
       - Outcome: y
       - Exposure: x
       
-      Identification of direct effects
+      Identification of direct and total effects
       
       Model is correctly specified.
-      No adjustment needed to estimate the direct effect of `x` on `y`.
-      
-      Identification of total effects
-      
-      Model is correctly specified.
-      No adjustment needed to estimate the total effect of `x` on `y`.
+      No adjustment needed to estimate the direct and total effect of `x` on `y`.
       
 
 ---
@@ -28,15 +23,10 @@
       - Exposure: x
       - Adjustment: b
       
-      Identification of direct effects
-      
-      Model is correctly specified.
-      All minimal sufficient adjustments to estimate the direct effect were done.
-      
-      Identification of total effects
+      Identification of direct and total effects
       
       Model is correctly specified.
-      All minimal sufficient adjustments to estimate the total effect were done.
+      All minimal sufficient adjustments to estimate the direct and total effect were done.
       
 
 ---
@@ -48,16 +38,10 @@
       - Outcome: y
       - Exposure: x
       
-      Identification of direct effects
-      
-      Incorrectly adjusted!
-      To estimate the direct effect, also adjust for `b`.
-      Currently, the model does not adjust for any variables.
-      
-      Identification of total effects
+      Identification of direct and total effects
       
       Incorrectly adjusted!
-      To estimate the total effect, also adjust for `b`.
+      To estimate the direct and total effect, at least adjust for `b`.
       Currently, the model does not adjust for any variables.
       
 
@@ -71,16 +55,10 @@
       - Exposure: x
       - Adjustment: c
       
-      Identification of direct effects
-      
-      Incorrectly adjusted!
-      To estimate the direct effect, also adjust for `b` and `c`.
-      Currently, the model only adjusts for `c`.
-      
-      Identification of total effects
+      Identification of direct and total effects
       
       Incorrectly adjusted!
-      To estimate the total effect, also adjust for `b` and `c`.
+      To estimate the direct and total effect, at least adjust for `b` and `c`.
       Currently, the model only adjusts for `c`.
       
 
@@ -94,16 +72,10 @@
       - Exposure: x
       - Adjustment: c
       
-      Identification of direct effects
-      
-      Incorrectly adjusted!
-      To estimate the direct effect, also adjust for `b` and `c`.
-      Currently, the model only adjusts for `c`.
-      
-      Identification of total effects
+      Identification of direct and total effects
       
       Incorrectly adjusted!
-      To estimate the total effect, also adjust for `b` and `c`.
+      To estimate the direct and total effect, at least adjust for `b` and `c`.
       Currently, the model only adjusts for `c`.
       
 
@@ -117,15 +89,10 @@
       - Exposure: wt
       - Adjustments: cyl, disp and gear
       
-      Identification of direct effects
-      
-      Model is correctly specified.
-      All minimal sufficient adjustments to estimate the direct effect were done.
-      
-      Identification of total effects
+      Identification of direct and total effects
       
       Model is correctly specified.
-      All minimal sufficient adjustments to estimate the total effect were done.
+      All minimal sufficient adjustments to estimate the direct and total effect were done.
       
 
 # check_dag, multiple adjustment sets
@@ -137,20 +104,10 @@
       - Outcome: exam
       - Exposure: podcast
       
-      Identification of direct effects
-      
-      Incorrectly adjusted!
-      To estimate the direct effect, also adjust for one of the following sets:
-      - alertness, prepared
-      - alertness, skills_course
-      - mood, prepared
-      - mood, skills_course.
-      Currently, the model does not adjust for any variables.
-      
-      Identification of total effects
+      Identification of direct and total effects
       
       Incorrectly adjusted!
-      To estimate the total effect, also adjust for one of the following sets:
+      To estimate the direct and total effect, at least adjust for one of the following sets:
       - alertness, prepared
       - alertness, skills_course
       - mood, prepared
@@ -168,14 +125,9 @@
       - Exposure: podcast
       - Adjustments: alertness and prepared
       
-      Identification of direct effects
-      
-      Model is correctly specified.
-      All minimal sufficient adjustments to estimate the direct effect were done.
-      
-      Identification of total effects
+      Identification of direct and total effects
       
       Model is correctly specified.
-      All minimal sufficient adjustments to estimate the total effect were done.
+      All minimal sufficient adjustments to estimate the direct and total effect were done.