R/graph_proxies.R

In JohnCoene/sigmajs: Interface to 'Sigma.js' Graph Visualization Library

#' Add node or edge
#'
#' Proxies to dynamically add a node or an edge to an already existing graph.
#'
#' @param proxy An object of class \code{sigmajsProxy} as returned by \code{\link{sigmajsProxy}}.
#' @param data A \code{data.frame} of _one_ node or edge.
#' @param ... any column.
#' @param refresh Whether to refresh the graph after node is dropped, required to take effect, if you are running force the algorithm is killed.
#'
#' @examples
#' \dontrun{
#' demo("add-node", package = "sigmajs")
#' demo("add-edge", package = "sigmajs")
#' demo("add-node-edge", package = "sigmajs")
#' }
#'
#' @note Have the parameters from your initial graph match that of the node you add, i.e.: if you pass \code{size} in your initial chart,
#' make sure you also have it in your proxy.
#'
#' @return The \code{proxy} object.
#'
#' @rdname add_p
#' @export
sg_add_node_p <- function(proxy, data, ..., refresh = TRUE) {

  if (missing(proxy))
    stop("must pass proxy", call. = FALSE)

  .test_proxy(proxy)

  # build data
  nodes <- .build_data(data, ...) %>%
    .check_ids() %>%
    .check_x_y() %>%
    .as_list()

  message <- list(id = proxy$id, data = nodes, refresh = refresh) # create message

  proxy$session$sendCustomMessage("sg_add_node_p", message)

  return(proxy)
}

#' @rdname add_p
#' @export
sg_add_edge_p <- function(proxy, data, ..., refresh = TRUE) {

  if (missing(proxy))
    stop("must pass proxy", call. = FALSE)

  .test_proxy(proxy)

  # build data
  edges <- .build_data(data, ...) %>%
    .check_ids() %>%
    .check_x_y() %>%
    .as_list()

  message <- list(id = proxy$id, data = edges, refresh = refresh) # create message

  proxy$session$sendCustomMessage("sg_add_edge_p", message) # send message

  return(proxy)
}

#' Add nodes or edges
#'
#' Proxies to dynamically add *multiple* nodes or edges to an already existing graph.
#'
#' @param proxy An object of class \code{sigmajsProxy} as returned by \code{\link{sigmajsProxy}}.
#' @param data A \code{data.frame} of nodes or edges.
#' @param ... any column.
#' @param refresh Whether to refresh the graph after node is dropped, required to take effect, if you are running force the algorithm is killed and restarted at every iteration..
#' @param rate Refresh rate, either \code{once}, the graph is refreshed after data.frame of nodes is added or at each \code{iteration} (row-wise). Only applies if \code{refresh} is set to \code{TRUE}.
#'
#' @examples
#' \dontrun{
#' demo("add-nodes", package = "sigmajs")
#' demo("add-edges", package = "sigmajs")
#' }
#'
#' @note Have the parameters from your initial graph match that of the node you add, i.e.: if you pass \code{size} in your initial chart,
#' make sure you also have it in your proxy.
#'
#' @return The \code{proxy} object.
#'
#' @rdname adds_p
#' @export
sg_add_nodes_p <- function(proxy, data, ..., refresh = TRUE, rate = "once") {

  if (missing(proxy))
    stop("must pass proxy", call. = FALSE)

  .test_proxy(proxy)

  if (missing(data))
    stop("must pass data", call. = FALSE)

  if (!rate %in% c("once", "iteration"))
    stop("incorrect rate", call. = FALSE)

  # build data
  nodes <- .build_data(data, ...) %>%
    .check_ids() %>%
    .check_x_y() %>%
    .as_list()

  message <- list(id = proxy$id, data = nodes, refresh = refresh, rate = rate) # create message

  proxy$session$sendCustomMessage("sg_add_nodes_p", message)

  return(proxy)
}

#' @rdname adds_p
#' @export
sg_add_edges_p <- function(proxy, data, ..., refresh = TRUE, rate = "once") {

  if (missing(proxy))
    stop("must pass proxy", call. = FALSE)

  .test_proxy(proxy)

  if (missing(data))
    stop("must pass data", call. = FALSE)

  if (!rate %in% c("once", "iteration"))
    stop("incorrect rate", call. = FALSE)

  # build data
  nodes <- .build_data(data, ...) %>%
    .check_ids() %>%
    .check_x_y() %>%
    .as_list()

  message <- list(id = proxy$id, data = nodes, refresh = refresh, rate = rate) # create message

  proxy$session$sendCustomMessage("sg_add_edges_p", message)

  return(proxy)
}

#' Remove node or edge
#'
#' Proxies to dynamically remove a node or an edge to an already existing graph.
#'
#' @param proxy An object of class \code{sigmajsProxy} as returned by \code{\link{sigmajsProxy}}.
#' @param id Id of edge or node to delete.
#' @param refresh Whether to refresh the graph after node is dropped, required to take effect, if you are running force the algorithm is killed and restarted.
#'
#' @return The \code{proxy} object.
#'
#' @rdname drop_p
#' @export
sg_drop_node_p <- function(proxy, id, refresh = TRUE) {

  if (missing(proxy))
    stop("must pass proxy", call. = FALSE)

  .test_proxy(proxy)

  if (missing(id))
    stop("must pass id")

  message <- list(id = proxy$id, data = id, refresh = refresh)

  proxy$session$sendCustomMessage("sg_drop_node_p", message)

  return(proxy)
}

#' @rdname drop_p
#' @export
sg_drop_edge_p <- function(proxy, id, refresh = TRUE) {

  if (missing(proxy))
    stop("must pass proxy", call. = FALSE)

  .test_proxy(proxy)

  if (missing(id))
    stop("must pass id")

  message <- list(id = proxy$id, data = id, refresh = refresh)

  proxy$session$sendCustomMessage("sg_drop_edge_p", message)

  return(proxy)
}

#' Clear or kill the graph
#'
#' Clear all nodes and edges from the graph or kills the graph.
#'
#' @param proxy An object of class \code{sigmajsProxy} as returned by \code{\link{sigmajsProxy}}.
#' @param refresh Whether to refresh the graph after node is dropped, required to take effect, if you are running force the algorithm is killed and restarted.
#'
#' @return The \code{proxy} object.
#'
#' @rdname clear-kill
#' @export
sg_clear_p <- function(proxy, refresh = TRUE) {

  if (missing(proxy))
    stop("must pass proxy", call. = FALSE)

  .test_proxy(proxy)

  message <- list(id = proxy$id, refresh = refresh)

  proxy$session$sendCustomMessage("sg_clear_p", message)

  return(proxy)
}

#' @rdname clear-kill
#' @export
sg_kill_p <- function(proxy, refresh = TRUE) {

  if (missing(proxy))
    stop("must pass proxy", call. = FALSE)

  .test_proxy(proxy)

  message <- list(id = proxy$id, refresh = refresh)

  proxy$session$sendCustomMessage("sg_kill_p", message)

  return(proxy)
}

#' Add nodes or edges with a delay
#'
#' Proxies to dynamically add multiple nodes or edges to an already existing graph with a *delay* between each addition.
#'
#' @param proxy An object of class \code{sigmajsProxy} as returned by \code{\link{sigmajsProxy}}.
#' @param data A \code{data.frame} of _one_ node or edge.
#' @param ... any column.
#' @param refresh Whether to refresh the graph after node is dropped, required to take effect, if you are running force the algorithm is killed and restarted at every iteration.
#' @param delay Column name containing delay in milliseconds.
#' @param cumsum Whether to compute the cumulative sum of the delay.
#'
#' @details The delay helps for build dynamic visualisations where nodes and edges do not appear all at the same time.
#' How the delay works depends on the \code{cumsum} parameter. if \code{TRUE} the function computes the cumulative sum
#' of the delay to effectively add each row one after the other: delay is thus applied at each row (number of seconds to wait
#' before the row is added *since the previous row*). If \code{FALSE} this is the number of milliseconds to wait before the node or
#' edge is added to the visualisation; \code{delay} is used as passed to the function.
#'
#' @return The \code{proxy} object.
#'
#' @note Have the parameters from your initial graph match that of the node you add, i.e.: if you pass \code{size} in your initial chart,
#' make sure you also have it in your proxy.
#'
#' @rdname adds_delay_p
#' @export
sg_add_nodes_delay_p <- function(proxy, data, delay, ..., refresh = TRUE, cumsum = TRUE) {

  if (missing(proxy))
    stop("must pass proxy", call. = FALSE)

  .test_proxy(proxy)

  if (missing(data) || missing(delay))
    stop("must pass data and delay", call. = FALSE)

  delay_col <- eval(substitute(delay), data) # subset delay
  if (isTRUE(cumsum))
    delay_col <- cumsum(delay_col) # cumul for setTimeout
  delay_table <- dplyr::tibble(sigmajsdelay = delay_col) # build delay tibble

  # build data
  nodes <- .build_data(data, ...) %>%
    dplyr::bind_cols(delay_table) %>% # bind delay
    .check_ids() %>%
    .check_x_y() %>%
    .as_list()

  message <- list(id = proxy$id, data = nodes, refresh = refresh) # create message

  proxy$session$sendCustomMessage("sg_add_nodes_delay_p", message)

  return(proxy)
}

#' @rdname adds_delay_p
#' @export
sg_add_edges_delay_p <- function(proxy, data, delay, ..., refresh = TRUE, cumsum = TRUE) {

  if (missing(proxy))
    stop("must pass proxy", call. = FALSE)

  .test_proxy(proxy)

  if (missing(data) || missing(delay))
    stop("must pass data and delay", call. = FALSE)

  delay_col <- eval(substitute(delay), data) # subset delay
  if (isTRUE(cumsum))
    delay_col <- cumsum(delay_col) # cumul for setTimeout
  delay_table <- dplyr::tibble(sigmajsdelay = delay_col) # build delay tibble

  # build data
  nodes <- .build_data(data, ...) %>%
    dplyr::bind_cols(delay_table) %>% # bind delay
    .check_ids() %>%
    .check_x_y() %>%
    .as_list()

  message <- list(id = proxy$id, data = nodes, refresh = refresh) # create message

  proxy$session$sendCustomMessage("sg_add_edges_delay_p", message)

  return(proxy)
}

#' Drop nodes or edges
#'
#' Proxies to dynamically drop *multiple* nodes or edges from an already existing graph.
#'
#' @param proxy An object of class \code{sigmajsProxy} as returned by \code{\link{sigmajsProxy}}.
#' @param data A \code{data.frame} of nodes or edges.
#' @param ids Column containing ids to drop from the graph.
#' @param refresh Whether to refresh the graph after node is dropped, required to take effect.
#' @param rate Refresh rate, either \code{once}, the graph is refreshed after data.frame of nodes is added or at each \code{iteration} (row-wise). Only applies if \code{refresh} is set to \code{TRUE}.
#'
#' @return The \code{proxy} object.
#'
#' @note Have the parameters from your initial graph match that of the node you add, i.e.: if you pass \code{size} in your initial chart,
#' make sure you also have it in your proxy.
#'
#' @rdname drops_p
#' @export
sg_drop_nodes_p <- function(proxy, data, ids, refresh = TRUE, rate = "once") {

  if (missing(proxy))
    stop("must pass proxy", call. = FALSE)

  .test_proxy(proxy)

  if (missing(data))
    stop("must pass data", call. = FALSE)

  if (!rate %in% c("once", "iteration"))
    stop("incorrect rate", call. = FALSE)

  ids <- eval(substitute(ids), data) # subset ids

  message <- list(id = proxy$id, data = ids, refresh = refresh, rate = rate) # create message

  proxy$session$sendCustomMessage("sg_drop_nodes_p", message)

  return(proxy)
}

#' @rdname drops_p
#' @export
sg_drop_edges_p <- function(proxy, data, ids, refresh = TRUE, rate = "once") {

  if (missing(proxy))
    stop("must pass proxy", call. = FALSE)

  .test_proxy(proxy)

  if (missing(data))
    stop("must pass data", call. = FALSE)

  if (!rate %in% c("once", "iteration"))
    stop("incorrect rate", call. = FALSE)

  ids <- eval(substitute(ids), data) # subset ids

  message <- list(id = proxy$id, data = ids, refresh = refresh, rate = rate) # create message

  proxy$session$sendCustomMessage("sg_drop_edges_p", message)

  return(proxy)
}

#' Drop nodes or edges with a delay
#'
#' Proxies to dynamically drop multiple nodes or edges to an already existing graph with a *delay* between each removal.
#'
#' @param proxy An object of class \code{sigmajsProxy} as returned by \code{\link{sigmajsProxy}}.
#' @param data A \code{data.frame} of _one_ node or edge.
#' @param ids Ids of elements to drop.
#' @param refresh Whether to refresh the graph after node is dropped, required to take effect, if you are running force the algorithm is killed and restarted at every iteration.
#' @param delay Column name containing delay in milliseconds.
#' @param cumsum Whether to compute the cumulative sum of the delay.
#'
#' @details The delay helps for build dynamic visualisations where nodes and edges do not disappear all at the same time.
#' How the delay works depends on the \code{cumsum} parameter. if \code{TRUE} the function computes the cumulative sum
#' of the delay to effectively drop each row one after the other: delay is thus applied at each row (number of seconds to wait
#' before the row is dropped *since the previous row*). If \code{FALSE} this is the number of milliseconds to wait before the node or
#' edge is added to the visualisation; \code{delay} is used as passed to the function.
#'
#' @return The \code{proxy} object.
#'
#' @note Have the parameters from your initial graph match that of the node you add, i.e.: if you pass \code{size} in your initial chart,
#' make sure you also have it in your proxy.
#'
#' @rdname drop_delay_p
#' @export
sg_drop_nodes_delay_p <- function(proxy, data, ids, delay, refresh = TRUE, cumsum = TRUE) {

  if (missing(proxy))
    stop("must pass proxy", call. = FALSE)

  .test_proxy(proxy)

  if (missing(data))
    stop("must pass data", call. = FALSE)

  delay_col <- eval(substitute(delay), data) # subset delay
  if (isTRUE(cumsum))
    delay_col <- cumsum(delay_col) # cumul for setTimeout

  ids <- eval(substitute(ids), data) # subset ids

  to_drop <- dplyr::tibble(
    id = ids,
    sigmajsdelay = delay_col
  )

  to_drop <- dplyr::tibble(
    id = ids,
    sigmajsdelay = delay_col
  ) %>% # bind delay
    .as_list()

  message <- list(id = proxy$id, data = to_drop, refresh = refresh) # create message

  proxy$session$sendCustomMessage("sg_drop_nodes_delay_p", message)

  return(proxy)
}

#' @rdname drop_delay_p
#' @export
sg_drop_edges_delay_p <- function(proxy, data, ids, delay, refresh = TRUE, cumsum = TRUE) {

  if (missing(proxy))
    stop("must pass proxy", call. = FALSE)

  .test_proxy(proxy)

  if (missing(data))
    stop("must pass data", call. = FALSE)

  delay_col <- eval(substitute(delay), data) # subset delay
  if (isTRUE(cumsum))
    delay_col <- cumsum(delay_col) # cumul for setTimeout

  ids <- eval(substitute(ids), data) # subset ids

  to_drop <- dplyr::tibble(
    id = ids,
    sigmajsdelay = delay_col
  )

  to_drop <- dplyr::tibble(
    id = ids,
    sigmajsdelay = delay_col
  ) %>% # bind delay
    .as_list()

  message <- list(id = proxy$id, data = to_drop, refresh = refresh) # create message

  proxy$session$sendCustomMessage("sg_drop_edges_delay_p", message)

  return(proxy)
}

#' Read
#'
#' Read nodes and edges to add to the graph. Other proxy methods to add data to a graph have to add nodes and edges one by one,
#' thereby draining the browser, this method will add multiple nodes and edges more efficiently.
#'
#' @param proxy An object of class \code{sigmajsProxy} as returned by \code{\link{sigmajsProxy}}.
#' @param data A \code{data.frame} of _one_ node or edge.
#' @param ... any column.
#'
#' @section Functions:
#' \itemize{
#'   \item{\code{sg_read_nodes_p} read nodes.}
#'   \item{\code{sg_read_edges_p} read edges.}
#'   \item{\code{sg_read_exec_p} send read nodes and edges to JavaScript front end.}
#' }
#'
#' @examples
#' library(shiny)
#'
#' ui <- fluidPage(
#' 	actionButton("add", "add nodes & edges"),
#' 	sigmajsOutput("sg")
#' )
#'
#' server <- function(input, output, session){
#'
#' 	nodes <- sg_make_nodes()
#' 	edges <- sg_make_edges(nodes)
#'
#' 	output$sg <- renderSigmajs({
#' 		sigmajs() %>%
#' 			sg_nodes(nodes, id, label, color, size) %>%
#' 			sg_edges(edges, id, source, target) %>%
#' 			sg_layout()
#' 	})
#'
#' 	i <- 10
#'
#' 	observeEvent(input$add, {
#' 		new_nodes <- sg_make_nodes()
#' 		new_nodes$id <- as.character(as.numeric(new_nodes$id) + i)
#' 		i <<- i + 10
#' 		ids <- 1:(i)
#' 		new_edges <- data.frame(
#' 			id = as.character((i * 2 + 15):(i * 2 + 29)),
#' 			source = as.character(sample(ids, 15)),
#' 			target = as.character(sample(ids, 15))
#' 		)
#'
#' 		sigmajsProxy("sg") %>%
#' 			sg_force_kill_p() %>%
#' 			sg_read_nodes_p(new_nodes, id, label, color, size) %>%
#' 			sg_read_edges_p(new_edges, id, source, target) %>%
#' 			sg_read_exec_p() %>%
#' 			sg_force_start_p() %>%
#' 			sg_refresh_p()
#' 	})
#'
#' }
#'
#' if (interactive()) shinyApp(ui, server)
#'
#' @return The \code{proxy} object.
#'
#' @name read
#' @export
sg_read_nodes_p <- function(proxy, data, ...){

  .test_proxy(proxy)

  # build data
  nodes <- data %>%
    .build_data(...) %>%
    .check_ids() %>%
    .check_x_y() %>%
    .as_list()

  proxy$message$data$nodes <- nodes

  return(proxy)
}

#' @rdname read
#' @export
sg_read_edges_p <- function(proxy, data, ...){
  .test_proxy(proxy)

  # build data
  edges <- data %>%
    .build_data(...) %>%
    .check_ids() %>%
    .check_x_y() %>%
    .as_list()

  proxy$message$data$edges <- edges

  return(proxy)
}

#' @rdname read
#' @export
sg_read_exec_p <- function(proxy){
  .test_proxy(proxy)

  proxy$message$id <- proxy$id

  if (is.null(proxy$message$data$edges))
    proxy$message$data$edges <- list()

  if (is.null(proxy$message$data$nodes))
    proxy$message$data$nodes <- list()

  proxy$session$sendCustomMessage("sg_read_exec_p", proxy$message)
  return(proxy)
}

#' Batch read
#'
#' Read nodes and edges by batch with a delay.
#'
#' @param proxy An object of class \code{sigmajsProxy} as returned by \code{\link{sigmajsProxy}}.
#' @param data A \code{data.frame} of nodes or edges to add to the graph.
#' @param ... any column.
#' @param delay Column name of containing batch identifier.
#' @param refresh Whether to refresh the graph after each batch (\code{delay}) has been added to the graph.
#' Note that this will also automatically restart any running force layout.
#'
#' @details Add nodes and edges with \code{sg_read_delay_nodes_p} and \code{sg_read_delay_edges_p} then execute (send to JavaScript end) with \code{sg_read_delay_exec_p}.
#'
#' @examples
#' library(shiny)
#'
#' ui <- fluidPage(
#' 	actionButton("add", "add nodes & edges"),
#' 	sigmajsOutput("sg")
#' )
#'
#' server <- function(input, output, session){
#'
#' 	output$sg <- renderSigmajs({
#' 		sigmajs()
#' 	})
#'
#' 	observeEvent(input$add, {
#' 		nodes <- sg_make_nodes(50)
#' 		nodes$batch <- c(
#' 			rep(1000, 25),
#' 			rep(3000, 25)
#' 		)
#'
#' 		edges <- data.frame(
#' 			id = 1:80,
#' 			source = c(
#' 				sample(1:25, 40, replace = TRUE),
#' 				sample(1:50, 40, replace = TRUE)
#' 			),
#' 			target = c(
#' 				sample(1:25, 40, replace = TRUE),
#' 				sample(1:50, 40, replace = TRUE)
#' 			),
#' 			batch = c(
#' 				rep(1000, 40),
#' 				rep(3000, 40)
#' 			)
#' 		) %>%
#' 		dplyr::mutate_all(as.character)
#'
#' 		sigmajsProxy("sg") %>%
#'      sg_force_start_p() %>%
#' 			sg_read_delay_nodes_p(nodes, id, color, label, size, delay = batch) %>%
#' 			sg_read_delay_edges_p(edges, id, source, target, delay = batch) %>%
#' 			sg_read_delay_exec_p()  %>%
#' 			sg_force_stop_p()
#' 	})
#'
#' }
#'
#' if (interactive()) shinyApp(ui, server)
#'
#' @return The \code{proxy} object.
#'
#' @name read-batch
#' @export
sg_read_delay_nodes_p <- function(proxy, data, ..., delay){

  .test_proxy(proxy)

  if (missing(delay) || missing(data))
    stop("missing data or delay", call. = FALSE)

  delay <- deparse(substitute(delay))

  # build data
  nodes <- data %>%
    .build_data(..., delay = delay) %>%
    .check_ids() %>%
    .check_x_y() %>%
    split(.[["delay"]]) %>%
    purrr::map(.as_list)

  proxy$message$data$nodes <- nodes

  return(proxy)
}

#' @rdname read-batch
#' @export
sg_read_delay_edges_p <- function(proxy, data, ..., delay){
  .test_proxy(proxy)

  if (missing(delay) || missing(data))
    stop("missing data or delay", call. = FALSE)

  delay <- deparse(substitute(delay))

  # build data
  edges <- data %>%
    .build_data(..., delay = delay) %>%
    .check_ids() %>%
    .check_x_y() %>%
    split(.[["delay"]]) %>%
    purrr::map(.as_list)

  proxy$message$data$edges <- edges

  return(proxy)
}

#' @rdname read-batch
#' @export
sg_read_delay_exec_p <- function(proxy, refresh = TRUE){
  .test_proxy(proxy)

  proxy$message$id <- proxy$id

  if (is.null(proxy$message$data$edges))
    proxy$message$data$edges <- list()

  if (is.null(proxy$message$data$nodes))
    proxy$message$data$nodes <- list()

  proxy$message$data <- purrr::map2(proxy$message$data$nodes, proxy$message$data$edges, .grp) %>%
    unname()

  proxy$message$refresh <- refresh

  proxy$session$sendCustomMessage("sg_read_bacth_exec_p", proxy$message)
  return(proxy)
}

#' Animate
#'
#' Proxy to dynamically animate an already existing graph.
#'
#' @inheritParams sg_animate
#' @param proxy An object of class \code{sigmajsProxy} as returned by \code{\link{sigmajsProxy}}.
#'
#' @details You can animate, \code{x}, \code{y}, \code{size} and \code{color}.
#'
#' @note You have to make sure that all the columns you want to animate to
#' (e.g. \code{to_x}, \code{to_size}) are also provided as arguments when you
#' create the graph with \code{sigmajs() \%>\% sg_nodes()}.
#'
#' @seealso \code{\link{sg_animate}}
#'
#' @examples
#' \dontrun{
#' # generate graph
#' nodes <- sg_make_nodes(20)
#' edges <- sg_make_edges(nodes)
#'
#' # add transition
#' n <- nrow(nodes)
#' nodes$to_x <- runif(n, 5, 10)
#' nodes$to_y <- runif(n, 5, 10)
#' nodes$to_size <- runif(n, 5, 10)
#'
#' # in server function:
#' output$my_sigmajs_id <- renderSigmajs({
#'   sigmajs() %>%
#'     sg_nodes(nodes, id, label, size, color, to_x, to_y, to_size) %>%
#'     sg_edges(edges, id, source, target)
#' })
#'
#' observeEvent(input$button, {
#'   sigmajsProxy("my_sigmajs_id") %>%
#'     sg_animate_p(mapping = list(x = "to_x", y = "to_y", size = "to_size"),
#'                  options = list(duration = 1000), delay = 0)
#' })
#' }
#'
#' @return The \code{proxy} object.
#'
#' @rdname animation_p
#' @export
sg_animate_p <- function(proxy, mapping, options = list(easing = "cubicInOut"), delay = 5000) {

  if (missing(proxy) || missing(mapping))
    stop("missing proxy or mapping", call. = FALSE)

  .test_proxy(proxy)

  message <- list(id = proxy$id, mapping = mapping, options = options, delay = delay) # create message

  proxy$session$sendCustomMessage("sg_animate_p", message)

  return(proxy)
}