From 9d545c42783da867e1203205b7c905aeded3dff6 Mon Sep 17 00:00:00 2001 From: Malcolm Barrett Date: Sun, 3 Mar 2024 14:43:31 -0500 Subject: [PATCH 1/6] don't fight legend so hard, starting with drelationship --- R/drelationship.R | 29 ++++---- R/themes.R | 20 ++++-- .../ggdag-dconnected-d-separates-x-and-y.svg | 71 ++++++++----------- ...relationship-d-connects-xy-no-collider.svg | 29 ++++---- ...gdag-drelationship-d-separates-x-and-y.svg | 71 ++++++++----------- .../ggdag-dseparated-d-separates-x-and-y.svg | 71 ++++++++----------- 6 files changed, 132 insertions(+), 159 deletions(-) diff --git a/R/drelationship.R b/R/drelationship.R index 76d8010..0f30b99 100644 --- a/R/drelationship.R +++ b/R/drelationship.R @@ -169,16 +169,8 @@ node_drelationship <- function(.tdy_dag, from = NULL, to = NULL, controlling_for if (!is.null(controlling_for)) { .tdy_dag <- control_for(.tdy_dag, controlling_for) - } else { - .tdy_dag <- dplyr::mutate( - .tdy_dag, - collider_line = FALSE, - adjusted = "unadjusted" - ) - controlling_for <- c() } - .dseparated <- dagitty::dseparated(pull_dag(.tdy_dag), from, to, controlling_for) .from <- from .to <- to @@ -232,11 +224,24 @@ ggdag_drelationship <- function( stylized = deprecated(), collider_lines = TRUE ) { - p <- if_not_tidy_daggity(.tdy_dag) %>% - node_drelationship(from = from, to = to, controlling_for = controlling_for, ...) %>% - ggplot2::ggplot(aes_dag(shape = adjusted, col = d_relationship)) + df <- if_not_tidy_daggity(.tdy_dag) %>% + node_drelationship( + from = from, + to = to, + controlling_for = controlling_for, + ... + ) + + has_adjusted <- "adjusted" %in% names(pull_dag_data(df)) + if (has_adjusted) { + mapping <- aes_dag(shape = adjusted, color = d_relationship) + } else { + mapping <- aes_dag(color = d_relationship) + } + + p <- ggplot2::ggplot(df, mapping) - if (collider_lines) p <- p + geom_dag_collider_edges() + if (has_adjusted && collider_lines) p <- p + geom_dag_collider_edges() p <- p + geom_dag( size = size, diff --git a/R/themes.R b/R/themes.R index ec0fd40..0df9611 100644 --- a/R/themes.R +++ b/R/themes.R @@ -137,17 +137,27 @@ theme_dag_gray_grid <- theme_dag_grey_grid scale_adjusted <- function(include_alpha = FALSE) { list( ggplot2::scale_linetype_manual(name = NULL, values = "dashed"), - ggplot2::scale_shape_manual(drop = FALSE, values = c("adjusted" = 15, "unadjusted" = 19), limits = c("adjusted", "unadjusted")), + ggplot2::scale_shape_manual( + values = c("adjusted" = 15, "unadjusted" = 19), + limits = c("adjusted", "unadjusted") + ), ggplot2::scale_color_discrete(limits = c("adjusted", "unadjusted")), - if (include_alpha) ggplot2::scale_alpha_manual(drop = FALSE, values = c("adjusted" = .30, "unadjusted" = 1), limits = c("adjusted", "unadjusted")), - if (include_alpha) ggraph::scale_edge_alpha_manual(name = NULL, drop = FALSE, values = c("adjusted" = .30, "unadjusted" = 1), limits = c("adjusted", "unadjusted")) + if (include_alpha) ggplot2::scale_alpha_manual( + values = c("adjusted" = .30, "unadjusted" = 1), + limits = c("adjusted", "unadjusted") + ), + if (include_alpha) ggraph::scale_edge_alpha_manual( + name = NULL, + values = c("adjusted" = .30, "unadjusted" = 1), + limits = c("adjusted", "unadjusted") + ) ) } breaks <- function(breaks = ggplot2::waiver(), name = ggplot2::waiver()) { list( - ggplot2::scale_color_discrete(name = name, drop = FALSE, breaks = breaks), - ggplot2::scale_fill_discrete(name = name, drop = FALSE, breaks = breaks) + ggplot2::scale_color_discrete(name = name, breaks = breaks), + ggplot2::scale_fill_discrete(name = name, breaks = breaks) ) } diff --git a/tests/testthat/_snaps/drelationship/ggdag-dconnected-d-separates-x-and-y.svg b/tests/testthat/_snaps/drelationship/ggdag-dconnected-d-separates-x-and-y.svg index a111c25..71e98ea 100644 --- a/tests/testthat/_snaps/drelationship/ggdag-dconnected-d-separates-x-and-y.svg +++ b/tests/testthat/_snaps/drelationship/ggdag-dconnected-d-separates-x-and-y.svg @@ -21,23 +21,23 @@ - - + + - - - - - - - - - -m -x -y - + + + + + + + + + +m +x +y + 1.2 @@ -48,34 +48,21 @@ - - - - -0.0 -0.5 -1.0 -1.5 -x + + + + +0.0 +0.5 +1.0 +1.5 +x y - -adjusted - - - - -adjusted -unadjusted - -d-relationship - - - - - - -d-connected -d-separated + +d-relationship + + +d-separated ggdag_dconnected() d-separates x and y diff --git a/tests/testthat/_snaps/drelationship/ggdag-drelationship-d-connects-xy-no-collider.svg b/tests/testthat/_snaps/drelationship/ggdag-drelationship-d-connects-xy-no-collider.svg index 626f8da..62653e7 100644 --- a/tests/testthat/_snaps/drelationship/ggdag-drelationship-d-connects-xy-no-collider.svg +++ b/tests/testthat/_snaps/drelationship/ggdag-drelationship-d-connects-xy-no-collider.svg @@ -58,22 +58,19 @@ 1.5 x y - -adjusted - - - - -adjusted -unadjusted - -d-relationship - - - - -d-connected -d-separated + +d-relationship + + +d-connected + +adjusted + + + + +adjusted +unadjusted ggdag_drelationship() d-connects xy: no collider diff --git a/tests/testthat/_snaps/drelationship/ggdag-drelationship-d-separates-x-and-y.svg b/tests/testthat/_snaps/drelationship/ggdag-drelationship-d-separates-x-and-y.svg index a1aae26..1de213d 100644 --- a/tests/testthat/_snaps/drelationship/ggdag-drelationship-d-separates-x-and-y.svg +++ b/tests/testthat/_snaps/drelationship/ggdag-drelationship-d-separates-x-and-y.svg @@ -21,23 +21,23 @@ - - + + - - - - - - - - - -m -x -y - + + + + + + + + + +m +x +y + 1.2 @@ -48,34 +48,21 @@ - - - - -0.0 -0.5 -1.0 -1.5 -x + + + + +0.0 +0.5 +1.0 +1.5 +x y - -adjusted - - - - -adjusted -unadjusted - -d-relationship - - - - - - -d-connected -d-separated + +d-relationship + + +d-separated ggdag_drelationship() d-separates x and y diff --git a/tests/testthat/_snaps/drelationship/ggdag-dseparated-d-separates-x-and-y.svg b/tests/testthat/_snaps/drelationship/ggdag-dseparated-d-separates-x-and-y.svg index 8230147..dfc2ea5 100644 --- a/tests/testthat/_snaps/drelationship/ggdag-dseparated-d-separates-x-and-y.svg +++ b/tests/testthat/_snaps/drelationship/ggdag-dseparated-d-separates-x-and-y.svg @@ -21,23 +21,23 @@ - - + + - - - - - - - - - -m -x -y - + + + + + + + + + +m +x +y + 1.2 @@ -48,34 +48,21 @@ - - - - -0.0 -0.5 -1.0 -1.5 -x + + + + +0.0 +0.5 +1.0 +1.5 +x y - -adjusted - - - - -adjusted -unadjusted - -d-relationship - - - - - - -d-connected -d-separated + +d-relationship + + +d-separated ggdag_dseparated() d-separates x and y From 6d0566a1a7b06a23538f265186cba5d81cdb5739 Mon Sep 17 00:00:00 2001 From: Malcolm Barrett Date: Sun, 3 Mar 2024 14:44:32 -0500 Subject: [PATCH 2/6] accept changes --- .../ggdag-equivalent-class-plots-all-reversible-edges.svg | 1 - .../equivalence/ggdag-equivalent-class-plots-labels.svg | 4 ++-- tests/testthat/_snaps/geom_dag/geom-dag-label-labels.svg | 6 +++--- .../_snaps/geom_dag/geom-dag-label-repel-repels-labels.svg | 2 +- 4 files changed, 6 insertions(+), 7 deletions(-) diff --git a/tests/testthat/_snaps/equivalence/ggdag-equivalent-class-plots-all-reversible-edges.svg b/tests/testthat/_snaps/equivalence/ggdag-equivalent-class-plots-all-reversible-edges.svg index c458e0d..213ebc2 100644 --- a/tests/testthat/_snaps/equivalence/ggdag-equivalent-class-plots-all-reversible-edges.svg +++ b/tests/testthat/_snaps/equivalence/ggdag-equivalent-class-plots-all-reversible-edges.svg @@ -66,7 +66,6 @@ - diff --git a/tests/testthat/_snaps/equivalence/ggdag-equivalent-class-plots-labels.svg b/tests/testthat/_snaps/equivalence/ggdag-equivalent-class-plots-labels.svg index 282a445..c82657c 100644 --- a/tests/testthat/_snaps/equivalence/ggdag-equivalent-class-plots-labels.svg +++ b/tests/testthat/_snaps/equivalence/ggdag-equivalent-class-plots-labels.svg @@ -18,7 +18,7 @@ - + @@ -167,7 +167,7 @@ x y z - + Exposure Outcome diff --git a/tests/testthat/_snaps/geom_dag/geom-dag-label-labels.svg b/tests/testthat/_snaps/geom_dag/geom-dag-label-labels.svg index 47ced35..aec5ef0 100644 --- a/tests/testthat/_snaps/geom_dag/geom-dag-label-labels.svg +++ b/tests/testthat/_snaps/geom_dag/geom-dag-label-labels.svg @@ -36,11 +36,11 @@ - + Collider - + Exposure - + Outcome diff --git a/tests/testthat/_snaps/geom_dag/geom-dag-label-repel-repels-labels.svg b/tests/testthat/_snaps/geom_dag/geom-dag-label-repel-repels-labels.svg index da98016..f013858 100644 --- a/tests/testthat/_snaps/geom_dag/geom-dag-label-repel-repels-labels.svg +++ b/tests/testthat/_snaps/geom_dag/geom-dag-label-repel-repels-labels.svg @@ -40,7 +40,7 @@ x y - + Here is where they collide This is the exposure From d783c800af138809c9206a9266b264745c85bb5f Mon Sep 17 00:00:00 2001 From: Malcolm Barrett Date: Sun, 3 Mar 2024 14:51:57 -0500 Subject: [PATCH 3/6] update expectations in d connections --- R/drelationship.R | 2 -- tests/testthat/test-tidy_dag.R | 8 ++++++-- 2 files changed, 6 insertions(+), 4 deletions(-) diff --git a/R/drelationship.R b/R/drelationship.R index 0f30b99..3bfcbbc 100644 --- a/R/drelationship.R +++ b/R/drelationship.R @@ -75,8 +75,6 @@ node_dconnected <- function(.tdy_dag, from = NULL, to = NULL, controlling_for = if (!is.null(controlling_for)) { .tdy_dag <- control_for(.tdy_dag, controlling_for) } else { - .tdy_dag <- .tdy_dag %>% - dplyr::mutate(collider_line = FALSE, adjusted = "unadjusted") controlling_for <- c() } diff --git a/tests/testthat/test-tidy_dag.R b/tests/testthat/test-tidy_dag.R index 34aa371..314a260 100644 --- a/tests/testthat/test-tidy_dag.R +++ b/tests/testthat/test-tidy_dag.R @@ -137,16 +137,20 @@ test_that("node functions produce correct columns", { expect_function_produces_name(node_collider(tidy_dag), "colliders") expect_function_produces_name( node_dconnected(tidy_dag, "x", "y"), + "d_relationship" + ) + expect_function_produces_name( + node_dconnected(tidy_dag, "x", "y", controlling_for = "z"), c("adjusted", "d_relationship") ) expect_function_produces_name(node_descendants(tidy_dag, "z"), "descendant") expect_function_produces_name( node_drelationship(tidy_dag, "x", "y"), - c("adjusted", "d_relationship") + "d_relationship" ) expect_function_produces_name( node_dseparated(tidy_dag, "x", "y"), - c("adjusted", "d_relationship") + "d_relationship" ) expect_function_produces_name(node_equivalent_class(tidy_dag), "reversable") expect_function_produces_name(node_equivalent_dags(tidy_dag), "dag") From 2e0c371886597e82927d7d898e530a734f75c8fd Mon Sep 17 00:00:00 2001 From: Malcolm Barrett Date: Mon, 4 Mar 2024 13:48:44 -0500 Subject: [PATCH 4/6] modify instrumental legends --- R/instrumental.R | 37 +++--- ...al-identifies-i-and-i2-as-instrumental.svg | 20 +--- ...tal-identifies-nothing-as-instrumental.svg | 106 ++++++++---------- ...nstrumental-instrumental-plus-collider.svg | 22 ++-- 4 files changed, 80 insertions(+), 105 deletions(-) diff --git a/R/instrumental.R b/R/instrumental.R index 416e4f3..20d286d 100644 --- a/R/instrumental.R +++ b/R/instrumental.R @@ -40,11 +40,6 @@ node_instrumental <- function(.dag, exposure = NULL, outcome = NULL, ...) { if (purrr::is_empty(i_vars)) { .dag <- dplyr::mutate( .dag, - adjusted = factor( - "unadjusted", - levels = c("unadjusted", "adjusted"), - exclude = NA - ), instrumental = NA ) return(.dag) @@ -58,14 +53,6 @@ node_instrumental <- function(.dag, exposure = NULL, outcome = NULL, ...) { ) if (!is.null(.z)) { .dag <- .dag %>% control_for(.z, activate_colliders = FALSE) - } else { - .dag <- .dag %>% dplyr::mutate( - adjusted = factor( - "unadjusted", - levels = c("unadjusted", "adjusted"), - exclude = NA - ) - ) } .dag <- .dag %>% dplyr::mutate( instrumental = ifelse(name == .i, "instrumental", NA) @@ -106,17 +93,21 @@ ggdag_instrumental <- function( ) { .tdy_dag <- if_not_tidy_daggity(.tdy_dag) %>% node_instrumental(exposure = exposure, outcome = outcome, ...) + has_instrumental <- !all(is.na((pull_dag_data(.tdy_dag)$instrumental))) + has_adjusted <- "adjusted" %in% names(pull_dag_data(.tdy_dag)) + mapping <- aes_dag() + if (has_adjusted) { + mapping$shape <- substitute(adjusted) + } - if (all(is.na((pull_dag_data(.tdy_dag)$instrumental)))) { - mapping <- aes_dag(shape = adjusted) - } else { - mapping <- aes_dag(shape = adjusted, color = instrumental) + if (has_instrumental) { + mapping$colour <- substitute(instrumental) } p <- .tdy_dag %>% - ggplot2::ggplot(mapping) + - scale_adjusted() + - breaks("instrumental") + ggplot2::ggplot(mapping) + if (has_adjusted) p <- p + scale_adjusted() + if (has_instrumental) p <- p + breaks("instrumental") p <- p + geom_dag( @@ -141,10 +132,10 @@ ggdag_instrumental <- function( stylized = stylized ) - if (all(is.na(pull_dag_data(.tdy_dag)$instrumental))) { - p <- p + ggplot2::facet_wrap(~"{No instrumental variables present}") - } else { + if (has_instrumental) { p <- p + ggplot2::facet_wrap(~instrumental_name) + } else { + p <- p + ggplot2::facet_wrap(~"{No instrumental variables present}") } p } diff --git a/tests/testthat/_snaps/instrumental/ggdag-instrumental-identifies-i-and-i2-as-instrumental.svg b/tests/testthat/_snaps/instrumental/ggdag-instrumental-identifies-i-and-i2-as-instrumental.svg index 7998338..4cffe9e 100644 --- a/tests/testthat/_snaps/instrumental/ggdag-instrumental-identifies-i-and-i2-as-instrumental.svg +++ b/tests/testthat/_snaps/instrumental/ggdag-instrumental-identifies-i-and-i2-as-instrumental.svg @@ -18,7 +18,7 @@ - + @@ -127,19 +127,11 @@ x y - -adjusted - - - - -adjusted -unadjusted - -instrumental - - -instrumental + +instrumental + + +instrumental ggdag_instrumental() identifies `i` and `i2` as instrumental diff --git a/tests/testthat/_snaps/instrumental/ggdag-instrumental-identifies-nothing-as-instrumental.svg b/tests/testthat/_snaps/instrumental/ggdag-instrumental-identifies-nothing-as-instrumental.svg index 9095b02..61f299a 100644 --- a/tests/testthat/_snaps/instrumental/ggdag-instrumental-identifies-nothing-as-instrumental.svg +++ b/tests/testthat/_snaps/instrumental/ggdag-instrumental-identifies-nothing-as-instrumental.svg @@ -21,80 +21,72 @@ - - + + - - - - - - - - - - - - - - - - - - - - - - - - -t -x1 -x2 -x3 -x4 -y - + + + + + + + + + + + + + + + + + + + + + + + + +t +x1 +x2 +x3 +x4 +y + - - + + - - -{No instrumental variables present} + + +{No instrumental variables present} - - - - - --2.0 --1.5 --1.0 --0.5 -0.0 + + + + + +-2.0 +-1.5 +-1.0 +-0.5 +0.0 -1 0 1 -x +x y - -adjusted - - - - -adjusted -unadjusted ggdag_instrumental() identifies nothing as instrumental diff --git a/tests/testthat/_snaps/instrumental/ggdag-instrumental-instrumental-plus-collider.svg b/tests/testthat/_snaps/instrumental/ggdag-instrumental-instrumental-plus-collider.svg index 58ea6db..924b015 100644 --- a/tests/testthat/_snaps/instrumental/ggdag-instrumental-instrumental-plus-collider.svg +++ b/tests/testthat/_snaps/instrumental/ggdag-instrumental-instrumental-plus-collider.svg @@ -89,19 +89,19 @@ x y - -adjusted + +instrumental - - - -adjusted -unadjusted - -instrumental + +instrumental + +adjusted + + - -instrumental + +adjusted +unadjusted ggdag_instrumental() instrumental plus collider From 14c48bd8e15ce437caf3b0f96cd20800ecaf7f84 Mon Sep 17 00:00:00 2001 From: Malcolm Barrett Date: Thu, 7 Mar 2024 07:59:16 -0500 Subject: [PATCH 5/6] accept status --- ...-status-x-as-exposure-y-as-outcome-and-l-as-latent.svg | 8 ++++---- tests/testthat/test-tidy_dag.R | 2 +- 2 files changed, 5 insertions(+), 5 deletions(-) diff --git a/tests/testthat/_snaps/status/ggdag-status-x-as-exposure-y-as-outcome-and-l-as-latent.svg b/tests/testthat/_snaps/status/ggdag-status-x-as-exposure-y-as-outcome-and-l-as-latent.svg index 7fe430c..c05c6a4 100644 --- a/tests/testthat/_snaps/status/ggdag-status-x-as-exposure-y-as-outcome-and-l-as-latent.svg +++ b/tests/testthat/_snaps/status/ggdag-status-x-as-exposure-y-as-outcome-and-l-as-latent.svg @@ -33,9 +33,9 @@ - + - + l x y @@ -67,9 +67,9 @@ - + - + exposure outcome latent diff --git a/tests/testthat/test-tidy_dag.R b/tests/testthat/test-tidy_dag.R index 314a260..be1c66b 100644 --- a/tests/testthat/test-tidy_dag.R +++ b/tests/testthat/test-tidy_dag.R @@ -161,7 +161,7 @@ test_that("node functions produce correct columns", { exposure = "x", outcome = "y" ), - c("adjusted", "instrumental") + "instrumental" ) expect_function_produces_name(node_parents(tidy_dag, "z"), "parent") expect_function_produces_name(node_status(tidy_dag), "status") From aa84adb3131b9404742bae116438711daa9dcfb4 Mon Sep 17 00:00:00 2001 From: Malcolm Barrett Date: Thu, 7 Mar 2024 11:57:32 -0500 Subject: [PATCH 6/6] allow dropping --- R/relations.R | 8 ++++---- R/themes.R | 6 +++--- 2 files changed, 7 insertions(+), 7 deletions(-) diff --git a/R/relations.R b/R/relations.R index cda0f23..6f39a88 100644 --- a/R/relations.R +++ b/R/relations.R @@ -231,7 +231,7 @@ ggdag_children <- function( node_children(.var) %>% ggplot2::ggplot(aes_dag(color = children)) + scale_adjusted() + - breaks(c("parent", "child")) + breaks(c("parent", "child"), drop = FALSE) p <- p + geom_dag( size = size, @@ -288,7 +288,7 @@ ggdag_parents <- function( node_parents(.var) %>% ggplot2::ggplot(aes_dag(color = parent)) + scale_adjusted() + - breaks(c("parent", "child")) + breaks(c("parent", "child"), drop = FALSE) p <- p + geom_dag( size = size, @@ -344,7 +344,7 @@ ggdag_ancestors <- function( node_ancestors(.var) %>% ggplot2::ggplot(aes_dag(color = ancestor)) + scale_adjusted() + - breaks(c("ancestor", "descendant")) + breaks(c("ancestor", "descendant"), drop = FALSE) p <- p + geom_dag( size = size, @@ -401,7 +401,7 @@ ggdag_descendants <- function( node_descendants(.var) %>% ggplot2::ggplot(aes_dag(color = descendant)) + scale_adjusted() + - breaks(c("ancestor", "descendant")) + breaks(c("ancestor", "descendant"), drop = FALSE) p <- p + geom_dag( size = size, diff --git a/R/themes.R b/R/themes.R index 0df9611..455aa64 100644 --- a/R/themes.R +++ b/R/themes.R @@ -154,10 +154,10 @@ scale_adjusted <- function(include_alpha = FALSE) { ) } -breaks <- function(breaks = ggplot2::waiver(), name = ggplot2::waiver()) { +breaks <- function(breaks = ggplot2::waiver(), name = ggplot2::waiver(), drop = TRUE) { list( - ggplot2::scale_color_discrete(name = name, breaks = breaks), - ggplot2::scale_fill_discrete(name = name, breaks = breaks) + ggplot2::scale_color_discrete(name = name, breaks = breaks, drop = drop), + ggplot2::scale_fill_discrete(name = name, breaks = breaks, drop = drop) ) }