Optional visNetwork physics

NEWS.md

@@ -8,6 +8,7 @@
 * Avoid newly deprecated arguments and functions in `crew` 0.5.0.9003 (https://github.com/wlnadau/crew/issues/131).
 * Allow `tar_read()` etc. inside a pipeline whenever it uses a different data store (#1158, @MilesMcBain).
 * Set `seed = FALSE` in `future::future()` (#1166, @svraka).
+* Add a new `physics` argument to `tar_visnetwork()` and `tar_glimpse()` (#925, @Bdblodgett-usgs).
 
 # targets 1.3.0
 

R/class_visnetwork.R

@@ -5,7 +5,8 @@ visnetwork_init <- function(
   level_separation = NULL,
   degree_from = 1L,
   degree_to = 1L,
-  zoom_speed = 1
+  zoom_speed = 1,
+  physics = FALSE
 ) {
   visnetwork_new(
     network = network,
@@ -14,7 +15,8 @@ visnetwork_init <- function(
     level_separation = level_separation,
     degree_from = degree_from,
     degree_to = degree_to,
-    zoom_speed = zoom_speed
+    zoom_speed = zoom_speed,
+    physics = physics
   )
 }
 
@@ -25,7 +27,8 @@ visnetwork_new <- function(
   level_separation = NULL,
   degree_from = NULL,
   degree_to = NULL,
-  zoom_speed = NULL
+  zoom_speed = NULL,
+  physics = NULL
 ) {
   visnetwork_class$new(
     network = network,
@@ -34,7 +37,8 @@ visnetwork_new <- function(
     level_separation = level_separation,
     degree_from = degree_from,
     degree_to = degree_to,
-    zoom_speed = zoom_speed
+    zoom_speed = zoom_speed,
+    physics = physics
   )
 }
 
@@ -49,14 +53,16 @@ visnetwork_class <- R6::R6Class(
     degree_from = NULL,
     degree_to = NULL,
     zoom_speed = NULL,
+    physics = NULL,
     initialize = function(
       network = NULL,
       label = NULL,
       label_break = NULL,
       level_separation = NULL,
       degree_from = NULL,
       degree_to = NULL,
-      zoom_speed = NULL
+      zoom_speed = NULL,
+      physics = NULL
     ) {
       super$initialize(
         network = network,
@@ -65,8 +71,9 @@ visnetwork_class <- R6::R6Class(
       )
       self$level_separation <- level_separation
       self$degree_from <- degree_from
-      self$zoom_speed <- zoom_speed
       self$degree_to <- degree_to
+      self$zoom_speed <- zoom_speed
+      self$physics <- physics
     },
     produce_shapes = function(type) {
       shapes <- c(
@@ -98,7 +105,7 @@ visnetwork_class <- R6::R6Class(
       vertices <- self$network$vertices
       edges <- self$network$edges
       out <- visNetwork::visNetwork(nodes = vertices, edges = edges, main = "")
-      out <- visNetwork::visNodes(out, physics = FALSE)
+      out <- visNetwork::visNodes(out, physics = self$physics)
       out <- visNetwork::visEdges(
         out,
         smooth = list(type = "cubicBezier", forceDirection = "horizontal")

R/tar_glimpse.R

@@ -30,6 +30,8 @@
 #' @param zoom_speed Positive numeric of length 1, scaling factor on the
 #'   zoom speed. Above 1 zooms faster than default, below 1 zooms
 #'   lower than default.
+#' @param physics Logical of length 1, whether to implement interactive
+#'   physics in the graph, e.g. edge elasticity.
 #' @examples
 #' if (identical(Sys.getenv("TAR_INTERACTIVE_EXAMPLES"), "true")) {
 #' tar_dir({ # tar_dir() runs code from a temp dir for CRAN.
@@ -55,6 +57,7 @@ tar_glimpse <- function(
   degree_from = 1L,
   degree_to = 1L,
   zoom_speed = 1,
+  physics = FALSE,
   callr_function = callr::r,
   callr_arguments = targets::tar_callr_args_default(callr_function),
   envir = parent.frame(),
@@ -74,6 +77,8 @@ tar_glimpse <- function(
   tar_assert_scalar(zoom_speed)
   tar_assert_dbl(zoom_speed)
   tar_assert_positive(zoom_speed)
+  tar_assert_lgl(physics)
+  tar_assert_scalar(physics)
   tar_assert_callr_function(callr_function)
   tar_assert_list(callr_arguments)
   targets_arguments <- list(
@@ -86,7 +91,8 @@ tar_glimpse <- function(
     level_separation = level_separation,
     degree_from = degree_from,
     degree_to = degree_to,
-    zoom_speed = zoom_speed
+    zoom_speed = zoom_speed,
+    physics = physics
   )
   callr_outer(
     targets_function = tar_glimpse_inner,
@@ -111,7 +117,8 @@ tar_glimpse_inner <- function(
   level_separation,
   degree_from,
   degree_to,
-  zoom_speed
+  zoom_speed,
+  physics
 ) {
   meta <- meta_init(path_store = path_store)
   progress <- progress_init(path_store = path_store)
@@ -131,7 +138,8 @@ tar_glimpse_inner <- function(
     level_separation = level_separation,
     degree_from = degree_from,
     degree_to = degree_to,
-    zoom_speed = zoom_speed
+    zoom_speed = zoom_speed,
+    physics = physics
   )
   visual$update()
   visual$visual

R/tar_visnetwork.R

@@ -41,6 +41,7 @@ tar_visnetwork <- function(
   degree_from = 1L,
   degree_to = 1L,
   zoom_speed = 1,
+  physics = FALSE,
   reporter = targets::tar_config_get("reporter_outdated"),
   seconds_reporter = targets::tar_config_get("seconds_reporter"),
   callr_function = callr::r,
@@ -64,6 +65,8 @@ tar_visnetwork <- function(
   tar_assert_scalar(zoom_speed)
   tar_assert_dbl(zoom_speed)
   tar_assert_positive(zoom_speed)
+  tar_assert_lgl(physics)
+  tar_assert_scalar(physics)
   tar_config_assert_reporter_outdated(reporter)
   tar_assert_dbl(seconds_reporter)
   tar_assert_scalar(seconds_reporter)
@@ -84,6 +87,7 @@ tar_visnetwork <- function(
     degree_from = degree_from,
     degree_to = degree_to,
     zoom_speed = zoom_speed,
+    physics = physics,
     reporter = reporter,
     seconds_reporter = seconds_reporter
   )
@@ -113,6 +117,7 @@ tar_visnetwork_inner <- function(
   degree_from,
   degree_to,
   zoom_speed,
+  physics,
   reporter,
   seconds_reporter
 ) {
@@ -136,7 +141,8 @@ tar_visnetwork_inner <- function(
     level_separation = level_separation,
     degree_from = degree_from,
     degree_to = degree_to,
-    zoom_speed = zoom_speed
+    zoom_speed = zoom_speed,
+    physics = physics
   )
   visual$update()
   visual$visual