From 41da8a4d91f80c95b798e33b7159bb5d3f64afbf Mon Sep 17 00:00:00 2001
From: Daniel <mail@danielluedecke.de>
Date: Sat, 3 Aug 2024 21:25:42 +0200
Subject: [PATCH] Add plot-method for `check_dag()` (#352)

* Add plot-method for `check_dag()`

* update class

* use PR

* docs

* update

* docs

* typo
---
 DESCRIPTION               |   4 +-
 NAMESPACE                 |   1 +
 NEWS.md                   |   6 ++
 R/plot.check_dag.R        | 132 ++++++++++++++++++++++++++++++++++++++
 man/plot.see_check_dag.Rd |  66 +++++++++++++++++++
 5 files changed, 208 insertions(+), 1 deletion(-)
 create mode 100644 R/plot.check_dag.R
 create mode 100644 man/plot.see_check_dag.Rd

diff --git a/DESCRIPTION b/DESCRIPTION
index 12410928e..034c4dc60 100644
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -1,7 +1,7 @@
 Type: Package
 Package: see
 Title: Model Visualisation Toolbox for 'easystats' and 'ggplot2'
-Version: 0.8.5
+Version: 0.8.5.1
 Authors@R:
     c(person(given = "Daniel",
              family = "Lüdecke",
@@ -78,6 +78,7 @@ Suggests:
     DHARMa,
     emmeans,
     factoextra,
+    ggdag,
     ggdist,
     ggraph,
     ggrepel,
@@ -119,3 +120,4 @@ Config/testthat/edition: 3
 Config/testthat/parallel: true
 Config/Needs/website: easystats/easystatstemplate
 Config/rcmdcheck/ignore-inconsequential-notes: true
+Remotes: easystats/performance#761
diff --git a/NAMESPACE b/NAMESPACE
index 7dcf77601..7f5dce91b 100644
--- a/NAMESPACE
+++ b/NAMESPACE
@@ -30,6 +30,7 @@ S3method(plot,see_bayesfactor_parameters)
 S3method(plot,see_bayesfactor_savagedickey)
 S3method(plot,see_binned_residuals)
 S3method(plot,see_check_collinearity)
+S3method(plot,see_check_dag)
 S3method(plot,see_check_distribution)
 S3method(plot,see_check_distribution_numeric)
 S3method(plot,see_check_heteroscedasticity)
diff --git a/NEWS.md b/NEWS.md
index 271dd7251..b9abd37bf 100644
--- a/NEWS.md
+++ b/NEWS.md
@@ -1,3 +1,9 @@
+# see (development)
+
+## Changes
+
+- New `plot()` method for `performance::check_dag()`.
+
 # see 0.8.5
 
 ## Major Changes
diff --git a/R/plot.check_dag.R b/R/plot.check_dag.R
new file mode 100644
index 000000000..147500c89
--- /dev/null
+++ b/R/plot.check_dag.R
@@ -0,0 +1,132 @@
+#' Plot method for check DAGs
+#'
+#' The `plot()` method for the `performance::check_dag()` function.
+#'
+#' @param x A `check_dag` object.
+#' @param size_point Numeric value specifying size of point geoms.
+#' @param colors Character vector of length five, indicating the colors (in
+#' hex-format) for different types of variables.
+#' @param which Character string indicating which plot to show. Can be either
+#' `"all"`, `"current"` or `"required"`.
+#' @param check_colliders Logical indicating whether to highlight colliders.
+#' Set to `FALSE` if the algorithm to detect colliders is very slow.
+#' @param ... Not used.
+#'
+#' @return A ggplot2-object.
+#'
+#' @examplesIf require("ggdag", quietly = TRUE)
+#' library(performance)
+#' # incorrect adjustment
+#' dag <- check_dag(
+#'   y ~ x + b + c,
+#'   x ~ b,
+#'   outcome = "y",
+#'   exposure = "x"
+#' )
+#' dag
+#' plot(dag)
+#'
+#' # plot only model with required adjustments
+#' plot(dag, which = "required")
+#'
+#' # collider-bias?
+#' dag <- check_dag(
+#'   y ~ x + c + d,
+#'   x ~ c + d,
+#'   b ~ x,
+#'   b ~ y,
+#'   outcome = "y",
+#'   exposure = "x",
+#'   adjusted = "c"
+#' )
+#' plot(dag)
+#' @export
+plot.see_check_dag <- function(x,
+                               size_point = 15,
+                               colors = NULL,
+                               which = "all",
+                               check_colliders = TRUE,
+                               ...) {
+  .data <- NULL
+  insight::check_if_installed(c("ggdag", "ggplot2"))
+  which <- match.arg(which, choices = c("all", "current", "required"))
+
+  # get plot data
+  p1 <- p2 <- suppressWarnings(ggdag::dag_adjustment_sets(x))
+  adjusted_for <- attributes(x)$adjusted
+
+  # for current plot, we need to update the "adjusted" column
+  p1$data$adjusted <- "unadjusted"
+  if (!is.null(adjusted_for)) {
+    p1$data$adjusted[p1$data$name %in% adjusted_for] <- "adjusted"
+  }
+
+  # tweak data
+  p1$data$type <- as.character(p1$data$adjusted)
+  if (check_colliders) {
+    p1$data$type[vapply(p1$data$name, ggdag::is_collider, logical(1), .dag = x)] <- "collider"
+  }
+  p1$data$type[p1$data$name == attributes(x)$outcome] <- "outcome"
+  p1$data$type[p1$data$name %in% attributes(x)$exposure] <- "exposure"
+  p1$data$type <- factor(p1$data$type, levels = c("outcome", "exposure", "adjusted", "unadjusted", "collider"))
+
+  p2$data$type <- as.character(p2$data$adjusted)
+  if (check_colliders) {
+    p2$data$type[vapply(p2$data$name, ggdag::is_collider, logical(1), .dag = x)] <- "collider"
+  }
+  p2$data$type[p2$data$name == attributes(x)$outcome] <- "outcome"
+  p2$data$type[p2$data$name %in% attributes(x)$exposure] <- "exposure"
+  p2$data$type <- factor(p2$data$type, levels = c("outcome", "exposure", "adjusted", "unadjusted", "collider"))
+
+  if (is.null(colors)) {
+    point_colors <- see_colors(c("yellow", "cyan", "blue grey", "red", "orange"))
+  } else if (length(colors) != 5) {
+    insight::format_error("`colors` must be a character vector with five color-values.")
+  } else {
+    point_colors <- colors
+  }
+  names(point_colors) <- c("outcome", "exposure", "adjusted", "unadjusted", "collider")
+
+  plot1 <- ggplot2::ggplot(p1$data, ggplot2::aes(x = .data$x, y = .data$y)) +
+    geom_point_borderless(ggplot2::aes(fill = .data$type), size = size_point) +
+    ggdag::geom_dag_edges(
+      ggplot2::aes(
+        xend = .data$xend,
+        yend = .data$yend,
+        edge_alpha = .data$adjusted
+      )
+    ) +
+    ggdag::scale_adjusted() +
+    ggdag::geom_dag_label(ggplot2::aes(label = .data$name)) +
+    ggdag::theme_dag() +
+    ggplot2::scale_fill_manual(values = point_colors) +
+    ggplot2::ggtitle("Current model") +
+    ggplot2::guides(edge_alpha = "none")
+
+  plot2 <- ggplot2::ggplot(p2$data, ggplot2::aes(x = .data$x, y = .data$y)) +
+    geom_point_borderless(ggplot2::aes(fill = .data$type), size = size_point) +
+    ggdag::geom_dag_edges(
+      ggplot2::aes(
+        xend = .data$xend,
+        yend = .data$yend,
+        edge_alpha = .data$adjusted
+      )
+    ) +
+    ggdag::scale_adjusted() +
+    ggdag::geom_dag_label(ggplot2::aes(label = .data$name)) +
+    ggdag::theme_dag() +
+    ggplot2::scale_fill_manual(values = point_colors) +
+    ggplot2::ggtitle("Required model") +
+    ggplot2::guides(edge_alpha = "none")
+
+  if (which == "all") {
+    # fix legends
+    plot2 <- plot2 + ggplot2::theme(legend.position = "none")
+    # plot
+    plots(plot1, plot2, n_rows = 1)
+  } else if (which == "current") {
+    plot1
+  } else {
+    plot2
+  }
+}
diff --git a/man/plot.see_check_dag.Rd b/man/plot.see_check_dag.Rd
new file mode 100644
index 000000000..f1b00acd4
--- /dev/null
+++ b/man/plot.see_check_dag.Rd
@@ -0,0 +1,66 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/plot.check_dag.R
+\name{plot.see_check_dag}
+\alias{plot.see_check_dag}
+\title{Plot method for check DAGs}
+\usage{
+\method{plot}{see_check_dag}(
+  x,
+  size_point = 15,
+  colors = NULL,
+  which = "all",
+  check_colliders = TRUE,
+  ...
+)
+}
+\arguments{
+\item{x}{A \code{check_dag} object.}
+
+\item{size_point}{Numeric value specifying size of point geoms.}
+
+\item{colors}{Character vector of length five, indicating the colors (in
+hex-format) for different types of variables.}
+
+\item{which}{Character string indicating which plot to show. Can be either
+\code{"all"}, \code{"current"} or \code{"required"}.}
+
+\item{check_colliders}{Logical indicating whether to highlight colliders.
+Set to \code{FALSE} if the algorithm to detect colliders is very slow.}
+
+\item{...}{Not used.}
+}
+\value{
+A ggplot2-object.
+}
+\description{
+The \code{plot()} method for the \code{performance::check_dag()} function.
+}
+\examples{
+\dontshow{if (require("ggdag", quietly = TRUE)) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf}
+library(performance)
+# incorrect adjustment
+dag <- check_dag(
+  y ~ x + b + c,
+  x ~ b,
+  outcome = "y",
+  exposure = "x"
+)
+dag
+plot(dag)
+
+# plot only model with required adjustments
+plot(dag, which = "required")
+
+# collider-bias?
+dag <- check_dag(
+  y ~ x + c + d,
+  x ~ c + d,
+  b ~ x,
+  b ~ y,
+  outcome = "y",
+  exposure = "x",
+  adjusted = "c"
+)
+plot(dag)
+\dontshow{\}) # examplesIf}
+}