V1.0.0

DESCRIPTION

@@ -19,7 +19,6 @@ Imports:
     dagitty (>= 0.3.4),
     DiagrammeR (>= 1.0.11),
     dplyr (>= 1.1.4),
-    messaging (>= 0.1.0),
     purrr (>= 1.1.0),
     rlang (>= 1.1.6),
     stringr (>= 1.5.1),

NAMESPACE

@@ -1,14 +1,22 @@
 # Generated by roxygen2: do not edit by hand
 
+export(cleanup_existing_theme)
 export(get_conditioned_nodes)
 export(parse_edges)
 export(parse_edgestring)
 export(parse_nodes)
+export(qd_adjustment_sets)
 export(qd_dag)
 export(qd_save)
+export(qd_select_edges)
+export(qd_select_nodes)
+export(qd_set_edge_attrs)
+export(qd_set_node_attrs)
 export(qd_swig)
 export(qd_themes)
 export(qd_todagitty)
+export(select_edges_by_node_alpha_id)
+export(select_nodes_by_alpha_id)
 export(sep_opts)
 export(theme_qd_base)
 export(theme_qd_circles)

R/graph_operations.R

@@ -0,0 +1,78 @@
+#' Graph operations
+#'
+#' @param graph_obj A `quickdag` object output by [qd_dag()] or [qd_swig()].
+#' @param alpha_ids A vector of alphanumeric node IDs upon which to operate.
+#' @param ... Passed to [DiagrammeR::set_node_attrs()] or [DiagrammeR::set_edge_attrs()]
+#'   argument `node_attr` or `edge_attr`, respectively.
+#'   [DiagrammeR::set_edge_attrs()] argument of the same name.
+#' @param from_alpha A vector of alphanumeric source node IDs.
+#' @param to_alpha A vector of alphanumeric destination node IDs.
+#' @param set_op Passed to the `set_op` argument of [DiagrammeR::select_nodes_by_id()]
+#'   or [DiagrammeR::select_edges_by_node_id()]. Defaults to "union".
+#'
+#' @rdname graph_operations
+#' @export
+qd_set_node_attrs <- function(graph_obj, ..., alpha_ids) {
+  numids <- get_numids(graph_obj, alpha_ids)
+  graph_out <- DiagrammeR::set_node_attrs(graph_obj,
+                                          ...,
+                                          values = values,
+                                          nodes = numids)
+  graph_out
+}
+
+#' @rdname graph_operations
+#' @export
+qd_set_edge_attrs <- function(graph_obj, ...,
+                              from_alpha = NULL, to_alpha = NULL) {
+  from_numids <- NULL
+  to_numids <- NULL
+  if (!is.null(from_alpha)) {
+    from_numids <- get_numids(graph_obj, from_alpha)
+  }
+  if (!is.null(to_alpha)) {
+    to_numids <- get_numids(graph_obj, to_alpha)
+  }
+  graph_out <- DiagrammeR::set_edge_attrs(graph_obj,
+                                          ...,
+                                          values = values,
+                                          from = from_numids,
+                                          to = to_numids)
+  graph_out
+}
+
+#' @rdname graph_operations
+#' @export
+select_nodes_by_alpha_id <- function(graph_obj, alpha_ids, set_op = "union") {
+  numids <- get_numids(graph_obj, alpha_ids)
+  graph_out <- DiagrammeR::select_nodes_by_id(graph_obj,
+                                              nodes = numids,
+                                              set_op = set_op)
+  graph_out
+}
+
+#' @rdname graph_operations
+#' @export
+qd_select_nodes <- select_nodes_by_alpha_id
+
+#' @rdname graph_operations
+#' @export
+select_edges_by_node_alpha_id <- function(graph_obj, alpha_ids, set_op = "union") {
+  numids <- get_numids(graph_obj, alpha_ids)
+  graph_out <- DiagrammeR::select_edges_by_node_id(graph_obj,
+                                                   nodes = numids,
+                                                   set_op = set_op)
+  graph_out
+}
+
+#' @rdname graph_operations
+#' @export
+qd_select_edges <- select_edges_by_node_alpha_id
+
+#' Retrieves numeric IDs given alphanumeric IDs
+#' @inheritParams qd_set_node_attrs
+get_numids <- function(graph_obj, alpha_ids) {
+  graph_obj$nodes_df |>
+    dplyr::filter(alpha_id %in% alpha_ids) |>
+    dplyr::pull(id)
+}

R/parse.R

@@ -1,6 +1,6 @@
 #' @title Parse nodes
 #' @inheritParams qd_dag
-#' @rdname node-parsing
+#' @rdname node_parsing
 #' @export
 parse_nodes <- function(edgelist) {
   nodes <- unlist(lapply(edgelist,
@@ -12,7 +12,7 @@ parse_nodes <- function(edgelist) {
 
 #' @title Parse edges in a graph specification
 #' @param edgestring A single string containing some set of node-edge relationships
-#' @rdname edge-parsing
+#' @rdname edge_parsing
 #' @export
 parse_edgestring <- function(edgestring) {
   edgepat <- "\\<\\-\\>|\\-\\>|\\<\\-"
@@ -52,7 +52,7 @@ parse_edgestring <- function(edgestring) {
   Reduce(rbind, edge_mini_dfs)
 }
 
-#' @rdname edge-parsing
+#' @rdname edge_parsing
 #' @inheritParams qd_dag
 #' @export
 parse_edges <- function(edgelist) {

R/qd_dag.R

@@ -11,7 +11,7 @@
 #' @param edge_aes_opts A list feeding aesthetic options for edges to
 #'   [DiagrammeR::edge_aes()]. Defaults to empty list.
 #' @param format_special Render numeric elements in an alphanumeric `alpha_id` as
-#'   subcripts. Defaults to `TRUE`.
+#'   subcripts. Defaults to `FALSE`.
 #' @param verbose Indicate whether to print node and edge dataframes to the console.
 #'   See Details below. Defaults to `TRUE`.
 #' @param check_dag Logical. Check whether the graph conforms to the rules of DAGs.
@@ -31,7 +31,7 @@
 #' edges <- c("A -> { B C } <- L",
 #'            "B -> C")
 #'
-#' # make a DAG object and render the graph using the default theme
+#' # Make a DAG object and render the graph using the default theme
 #' g.obj <- qd_dag(edges)
 #' DiagrammeR::render_graph(g.obj)
 #'
@@ -51,8 +51,11 @@
 #'
 qd_dag <- function(edgelist, node_labs = NULL,
                    node_aes_opts = list(), edge_aes_opts = list(),
-                   format_special = TRUE,
-                   verbose = FALSE, check_dag = TRUE, theme = "base", ...) {
+                   format_special = getOption("quickdag.format_special"),
+                   verbose = getOption("quickdag.verbose"),
+                   check_dag = getOption("quickdag.check_dag"),
+                   theme = getOption("quickdag.theme"),
+                   ...) {
 
   # Identify Nodes --------------------------------------------------------
   ## extract unique nodes, sort in ascending order
@@ -171,5 +174,4 @@ qd_dag <- function(edgelist, node_labs = NULL,
 
   class(graph) <- c("quickdag", "dgr_graph")
   graph
-
 }

R/qd_save.R

@@ -33,7 +33,8 @@
 #'
 #' # clean up temporary directory
 #' file.remove(file)
-qd_save <- function(graph, file_name, ..., embed = FALSE, kg = NULL) {
+qd_save <- function(graph, file_name, ...,
+                    embed = getOption("quickdag.embed"), kg = NULL) {
   DiagrammeR::export_graph(graph = graph, file_name = file_name, ...)
 
   if (embed == TRUE) {

R/qd_swig.R

@@ -32,8 +32,8 @@
 qd_swig <- function(graph_obj,
                     fixed_nodes,
                     custom_values = NULL,
-                    fixed_sep = "vlin",
-                    sep_point_size = 15) {
+                    fixed_sep = getOption("quickdag.swig_fixedsep"),
+                    sep_point_size = getOption("quickdag.swig_sepsize")) {
 
   ndf <- DiagrammeR::get_node_df(graph_obj)
   ndf$fixed <- with(ndf, ifelse(alpha_id %in% fixed_nodes, TRUE, FALSE))

R/qd_todagitty.R

@@ -3,44 +3,58 @@
 #' @description
 #' Format an edgelist and send it to dagitty to identify variable adjustment sets.
 #'
-#' @param edgelist A vector of edge relationships. Must be strictly organized (see
-#'   example for format).
+#' @param edgelist A vector of edge relationships.
 #' @param diagram_type Character identifying the diagram type. Defaults to "dag", but
-#'   user can specify another graph type (see dagitty documentation).
+#'   user can specify another graph type (see [dagitty::adjustmentSets()]).
 #' @param showplot Logical indicating whether to produce a dagitty plot. Defaults to
 #'   `FALSE`.
 #' @param exposure Character. Specify exposure of interest. (Required)
 #' @param outcome Character. Specifiy outcome of interest. (Required)
-#' @param ... Pass arguments to [dagitty::adjustmentSets()]. See dagitty documentation
-#'   for options.
+#' @param ... Pass arguments to [dagitty::adjustmentSets()].
 #'
 #' @details
-#' The `exposure` and `outcome` options map to dagitty functions of the same name.
+#' The `exposure` and `outcome` options map to dagitty parameters of the same name.
 #'
+#' [qd_todagitty()] remains an alias for [qd_adjustment_sets()] to avoid breaking
+#' existing scripts, as it was the original name of this function.
+#'
+#' @rdname qd_adjustment_sets
 #' @export
 #' @examples
+#' # feed an edgelist to qd_adjustment_sets()
 #' edges <- c("A -> { B C D }",
 #'            "B -> C",
-#'            "E -> { B C }")
-#' # must pass exposure and outcome arguments to dagitty::adjustmentSets()
-#' qd_todagitty(edges, exposure = "A", outcome = "C")
-#' qd_todagitty(edges, exposure = "A", outcome = "C", type = "minimal")
-qd_todagitty <- function(edgelist, diagram_type = "dag", showplot = FALSE,
-                         exposure, outcome,
-                         ...) {
+#'            "E -> { B C }",
+#'            "Y <- L -> A")
+#' qd_adjustment_sets(edges, exposure = "A", outcome = "C")
+#' qd_adjustment_sets(edges, exposure = "A", outcome = "C", type = "minimal")
+#'
+#' # if you've already created a qd_dag() object
+#' dag <- qd_dag(edges)
+#' qd_adjustment_sets(dag$qd_edgelist, exposure = "A", outcome = "Y")
+qd_adjustment_sets <- function(edgelist, diagram_type = "dag", showplot = FALSE,
+                               exposure, outcome,
+                               ...) {
 
-  dagitty_obj <- dagitty::dagitty(paste(diagram_type, "{",
-                                        paste(edgelist, collapse = "; "),
-                                        "}"),
-                                  layout = TRUE)
+  dagitty_obj <- dagitty::dagitty(
+    paste(diagram_type, "{", paste(edgelist, collapse = "; "), "}"),
+    layout = TRUE
+  )
 
   ## optional to show dagitty plot
   if (showplot) {
     plot(dagitty_obj)
   }
 
   ## use dagitty's algorithm to identify adjustment sets
-  sets <- dagitty::adjustmentSets(dagitty_obj, exposure = exposure,
-                                  outcome = outcome, ...)
+  sets <- dagitty::adjustmentSets(dagitty_obj,
+                                  exposure = exposure,
+                                  outcome = outcome,
+                                  ...)
   return(sets)
 }
+
+
+#' @rdname qd_adjustment_sets
+#' @export
+qd_todagitty <- qd_adjustment_sets

R/sep_opts.R

@@ -40,11 +40,11 @@ sep_opts <- function(entity = NULL, table = FALSE) {
     )
   }
 
-  if (entity %in% names(defopts)) {
+  if (is.null(entity)) {
+    defopts
+  } else if (entity %in% names(defopts)) {
     defopts[names(defopts) == entity]
-  } else if (!is.null(entity)) {
-    entity
   } else {
-    defopts
+    entity
   }
 }