Merge pull request #499 from olivroy/check

Use chaining in checks + add snapshot tests

DESCRIPTION

@@ -29,7 +29,8 @@ Imports:
     purrr (>= 0.3.4),
     RColorBrewer (>= 1.1-2),
     readr (>= 2.1.1),
-    rlang (>= 0.4),
+    rlang (>= 1.1.0),
+    cli,
     rstudioapi (>= 0.7),
     scales (>= 1.1),
     stringr (>= 1.4),
@@ -42,7 +43,8 @@ Suggests:
     knitr,
     rmarkdown,
     rsvg,
-    testthat (>= 3.1.0)
+    testthat (>= 3.1.0),
+    withr
 VignetteBuilder:
     knitr
 Config/testthat/edition: 3

DiagrammeR.Rproj

@@ -20,3 +20,5 @@ PackageUseDevtools: Yes
 PackageInstallArgs: --no-multiarch --with-keep.source
 PackageCheckArgs: --as-cran --no-manual
 PackageRoxygenize: rd,collate,namespace
+
+UseNativePipeOperator: No

R/DiagrammeR.R

@@ -128,9 +128,6 @@ DiagrammeR <- function(
     ...
 ) {
 
-  # Get the name of the function
-  fcn_name <- get_calling_fcn()
-
   # DiagrammeR will serve as a wrapper function for mermaid and grVis
   if (grepl(x = type, pattern = "[m,M](erm).*")) {
 
@@ -140,10 +137,7 @@ DiagrammeR <- function(
     grViz(diagram, ... )
 
   } else {
-
-    emit_error(
-      fcn_name = fcn_name,
-      reasons = "The type should be `mermaid` or `grViz`")
+    abort("The type should be `mermaid` or `grViz`.")
   }
 }
 
@@ -158,16 +152,16 @@ DiagrammeR <- function(
 #' @export
 DiagrammeROutput <- function(
     outputId,
-    width = '100%',
-    height = 'auto'
+    width = "100%",
+    height = "auto"
 ) {
 
   htmlwidgets::shinyWidgetOutput(
     outputId,
-    'DiagrammeR',
+    "DiagrammeR",
     width,
     height,
-    package = 'DiagrammeR'
+    package = "DiagrammeR"
   )
 }
 

R/add_balanced_tree.R

@@ -98,32 +98,12 @@ add_balanced_tree <- function(
   # Get the time of function start
   time_function_start <- Sys.time()
 
-  # Get the name of the function
-  fcn_name <- get_calling_fcn()
-
   # Validation: Graph object is valid
-  if (!graph_object_valid(graph)) {
-
-    emit_error(
-      fcn_name = fcn_name,
-      reasons = "The graph object is not valid")
-  }
+  check_graph_valid(graph)
 
-  # Stop if k is too small
-  if (k <= 1) {
-
-    emit_error(
-      fcn_name = fcn_name,
-      reasons = "The value for `k` must be at least 2")
-  }
-
-  # Stop if h is too small
-  if (h <= 1) {
-
-    emit_error(
-      fcn_name = fcn_name,
-      reasons = "The value for `h` must be at least 2")
-  }
+  # Stop if k or n is too small
+  check_number_whole(k, min = 2)
+  check_number_whole(h, min = 2)
 
   # Determine the number of nodes in the balanced tree
   n_nodes_tree <-
@@ -181,17 +161,15 @@ add_balanced_tree <- function(
 
     if (nrow(node_aes_tbl) < n_nodes_tree) {
 
-      node_aes$index__ <- 1:n_nodes_tree
+      node_aes$index__ <- seq_len(n_nodes_tree)
 
       node_aes_tbl <-
         dplyr::as_tibble(node_aes) %>%
-        dplyr::select(-index__)
+        dplyr::select(-"index__")
     }
 
     if ("id" %in% colnames(node_aes_tbl)) {
-      node_aes_tbl <-
-        node_aes_tbl %>%
-        dplyr::select(-id)
+      node_aes_tbl$id <- NULL
     }
   }
 
@@ -202,17 +180,15 @@ add_balanced_tree <- function(
 
     if (nrow(node_data_tbl) < n_nodes_tree) {
 
-      node_data$index__ <- 1:n_nodes_tree
+      node_data$index__ <- seq_len(n_nodes_tree)
 
       node_data_tbl <-
         dplyr::as_tibble(node_data) %>%
-        dplyr::select(-index__)
+        dplyr::select(-"index__")
     }
 
     if ("id" %in% colnames(node_data_tbl)) {
-      node_data_tbl <-
-        node_data_tbl %>%
-        dplyr::select(-id)
+      node_data_tbl$id <- NULL
     }
   }
 
@@ -223,17 +199,15 @@ add_balanced_tree <- function(
 
     if (nrow(edge_aes_tbl) < n_edges_tree) {
 
-      edge_aes$index__ <- 1:n_edges_tree
+      edge_aes$index__ <- seq_len(n_edges_tree)
 
       edge_aes_tbl <-
         dplyr::as_tibble(edge_aes) %>%
-        dplyr::select(-index__)
+        dplyr::select(-"index__")
     }
 
     if ("id" %in% colnames(edge_aes_tbl)) {
-      edge_aes_tbl <-
-        edge_aes_tbl %>%
-        dplyr::select(-id)
+      edge_aes_tbl$id <- NULL
     }
   }
 
@@ -244,17 +218,15 @@ add_balanced_tree <- function(
 
     if (nrow(edge_data_tbl) < n_edges_tree) {
 
-      edge_data$index__ <- 1:n_edges_tree
+      edge_data$index__ <- seq_len(n_edges_tree)
 
       edge_data_tbl <-
         dplyr::as_tibble(edge_data) %>%
-        dplyr::select(-index__)
+        dplyr::select(-"index__")
     }
 
     if ("id" %in% colnames(edge_data_tbl)) {
-      edge_data_tbl <-
-        edge_data_tbl %>%
-        dplyr::select(-id)
+      edge_data_tbl$id <- NULL
     }
   }
 
@@ -311,6 +283,9 @@ add_balanced_tree <- function(
   # Update the `last_edge` counter
   graph$last_edge <- edges_created + nrow(tree_edges)
 
+  # Get the name of the function
+  fcn_name <- get_calling_fcn()
+
   # Update the `graph_log` df with an action
   graph_log <-
     add_action_to_log(

R/add_cycle.R

@@ -84,24 +84,11 @@ add_cycle <- function(
   # Get the time of function start
   time_function_start <- Sys.time()
 
-  # Get the name of the function
-  fcn_name <- get_calling_fcn()
-
   # Validation: Graph object is valid
-  if (!graph_object_valid(graph)) {
-
-    emit_error(
-      fcn_name = fcn_name,
-      reasons = "The graph object is not valid")
-  }
+  check_graph_valid(graph)
 
   # Stop if n is too small
-  if (n <= 2) {
-
-    emit_error(
-      fcn_name = fcn_name,
-      reasons = "The value for `n` must be at least 3")
-  }
+  check_number_whole(n, min = 3)
 
   # Get the number of nodes ever created for
   # this graph
@@ -125,7 +112,7 @@ add_cycle <- function(
   graph_directed <- graph$directed
 
   # Get the sequence of nodes required
-  nodes <- seq(1, n)
+  nodes <- seq_len(n)
 
   # Collect node aesthetic attributes
   if (!is.null(node_aes)) {
@@ -134,17 +121,15 @@ add_cycle <- function(
 
     if (nrow(node_aes_tbl) < n) {
 
-      node_aes$index__ <- 1:n
+      node_aes$index__ <- seq_len(n)
 
       node_aes_tbl <-
         dplyr::as_tibble(node_aes) %>%
-        dplyr::select(-index__)
+        dplyr::select(-"index__")
     }
 
     if ("id" %in% colnames(node_aes_tbl)) {
-      node_aes_tbl <-
-        node_aes_tbl %>%
-        dplyr::select(-id)
+      node_aes_tbl$id <- NULL
     }
   }
 
@@ -155,17 +140,15 @@ add_cycle <- function(
 
     if (nrow(edge_aes_tbl) < n) {
 
-      edge_aes$index__ <- 1:n
+      edge_aes$index__ <- seq_len(n)
 
       edge_aes_tbl <-
         dplyr::as_tibble(edge_aes) %>%
-        dplyr::select(-index__)
+        dplyr::select(-"index__")
     }
 
     if ("id" %in% colnames(edge_aes_tbl)) {
-      edge_aes_tbl <-
-        edge_aes_tbl %>%
-        dplyr::select(-id)
+      edge_aes_tbl$id <- NULL
     }
   }
 
@@ -176,17 +159,15 @@ add_cycle <- function(
 
     if (nrow(node_data_tbl) < n) {
 
-      node_data$index__ <- 1:n
+      node_data$index__ <- seq_len(n)
 
       node_data_tbl <-
         dplyr::as_tibble(node_data) %>%
-        dplyr::select(-index__)
+        dplyr::select(-"index__")
     }
 
     if ("id" %in% colnames(node_data_tbl)) {
-      node_data_tbl <-
-        node_data_tbl %>%
-        dplyr::select(-id)
+      node_data_tbl$id <- NULL
     }
   }
 
@@ -197,17 +178,15 @@ add_cycle <- function(
 
     if (nrow(edge_data_tbl) < n) {
 
-      edge_data$index__ <- 1:n
+      edge_data$index__ <- seq_len(n)
 
       edge_data_tbl <-
         dplyr::as_tibble(edge_data) %>%
-        dplyr::select(-index__)
+        dplyr::select(-"index__")
     }
 
     if ("id" %in% colnames(edge_data_tbl)) {
-      edge_data_tbl <-
-        edge_data_tbl %>%
-        dplyr::select(-id)
+      edge_data_tbl$id <- NULL
     }
   }
 
@@ -278,6 +257,9 @@ add_cycle <- function(
   # Update the `last_edge` counter
   graph$last_edge <- edges_created + nrow(cycle_edges)
 
+  # Get the name of the function
+  fcn_name <- get_calling_fcn()
+
   # Update the `graph_log` df with an action
   graph_log <-
     add_action_to_log(
@@ -298,8 +280,7 @@ add_cycle <- function(
   # Perform graph actions, if any are available
   if (nrow(graph$graph_actions) > 0) {
     graph <-
-      graph %>%
-      trigger_graph_actions()
+      trigger_graph_actions(graph)
   }
 
   # Write graph backup if the option is set