add geom_dag_label()

NAMESPACE

@@ -57,6 +57,7 @@ export(geom_dag_edges_arc)
 export(geom_dag_edges_diagonal)
 export(geom_dag_edges_fan)
 export(geom_dag_edges_link)
+export(geom_dag_label)
 export(geom_dag_label_repel)
 export(geom_dag_node)
 export(geom_dag_point)

R/StatsandGeoms.R

@@ -94,7 +94,6 @@ GeomDagText <- ggplot2::ggproto("GeomDagText", ggplot2::GeomText, default_aes =
   vjust = 0.5, alpha = NA, family = "", fontface = "bold", lineheight = 1.2
 ))
 
-
 StatEdgeLink <- ggplot2::ggproto("StatEdgeLink", ggraph::StatEdgeLink,
   setup_data = function(data, params) {
     data <- data[!is.na(data$xend), ]

R/geom_dag.R

@@ -159,6 +159,81 @@ geom_dag_text <- function(mapping = NULL, data = NULL,
   )
 }
 
+#' Node text labels
+#'
+#' @inheritParams ggplot2::geom_label
+#'
+#' @section Aesthetics:
+#' `geom_dag_label` understand the following aesthetics (required aesthetics are in bold):
+#'
+#' - **x**
+#' - **y**
+#' - **label**
+#' - alpha
+#' - angle
+#' - colour
+#' - family
+#' - fontface
+#' - group
+#' - hjust
+#' - lineheight
+#' - size
+#' - vjust
+#'
+#' @export
+#'
+#' @examples
+#' library(ggplot2)
+#' library(ggraph)
+#' g <- dagify(m ~ x + y, y ~ x)
+#'
+#' ggdag(g, text = FALSE) + geom_dag_label()
+#'
+#' g %>%
+#'   tidy_dagitty() %>%
+#'   ggplot(aes(x = x, y = y, xend = xend, yend = yend)) +
+#'   geom_dag_edges(aes(
+#'     start_cap = label_rect(name, padding = margin(2.5, 2.5, 2.5, 2.5, "mm")),
+#'     end_cap = label_rect(name, padding = margin(2.5, 2.5, 2.5, 2.5, "mm"))
+#'   )) +
+#'   geom_dag_label(size = 5, fill = "black", color = "white") +
+#'   theme_dag()
+geom_dag_label <- function(mapping = NULL, data = NULL,
+                          stat = "identity", position = "identity",
+                          ...,
+                          parse = FALSE,
+                          nudge_x = 0,
+                          nudge_y = 0,
+                          check_overlap = FALSE,
+                          na.rm = FALSE,
+                          show.legend = NA,
+                          inherit.aes = TRUE) {
+  if (!missing(nudge_x) || !missing(nudge_y)) {
+    if (!missing(position)) {
+      stop("Specify either `position` or `nudge_x`/`nudge_y`", call. = FALSE)
+    }
+
+    position <- ggplot2::position_nudge(nudge_x, nudge_y)
+  }
+
+  if (is.null(mapping)) mapping <- ggplot2::aes(label = name)
+  if (is.null(mapping$label)) mapping$label <- substitute(name)
+
+  ggplot2::layer(
+    data = data,
+    mapping = mapping,
+    stat = StatNodes,
+    geom = ggplot2::GeomLabel,
+    position = position,
+    show.legend = show.legend,
+    inherit.aes = inherit.aes,
+    params = list(
+      parse = parse,
+      na.rm = na.rm,
+      ...
+    )
+  )
+}
 
 #' Repulsive textual annotations
 #'

inst/WORDLIST

@@ -20,6 +20,7 @@ SEM
 Undirected
 acyclic
 aes
+algorithmically
 bb
 behaviour
 bidirected
@@ -31,6 +32,7 @@ dagitty
 de
 dendogram
 df
+dplyr
 edx
 fontface
 generalizability

tests/testthat/test-geom_dag.R

@@ -53,3 +53,21 @@ test_that("different edge types work", {
   expect_doppelganger("geom_dag_edges_diagonal() is arcy", p + geom_dag_edges_diagonal())
   expect_doppelganger("geom_dag_edges_fan() is fany", p + geom_dag_edges_fan())
 })
+test_that("labels also work", {
+  g <- dagify(m ~ x + y,
+              y ~ x,
+              exposure = "x",
+              outcome = "y",
+              latent = "m",
+              labels = c("x" = "Exposure", "y" = "Outcome", "m" = "Collider")
+  )
+
+  p1 <- g %>%
+    tidy_dagitty() %>%
+    ggplot(aes(x = x, y = y, xend = xend, yend = yend)) +
+    geom_dag_edges() +
+    geom_dag_point() +
+    geom_dag_label(aes(label = label))
+
+  expect_doppelganger("geom_dag_label() labels", p1)
+})