A function to style a visNetwork object from {targets} - either from tar_visnetork of tar_glimpse

tar_vis_style.R

#' Customise style of a targets-derived visNetwork object
#'
#' @param v object class "visNetwork" from either `tar_visnetwork` or `tar_glimpse` 
#' @param colors character vector of length 1 or 3. Hex colour codes to define: 
#' Up to Date, Errored and Outdated targets (in that order). If an object from 
#' `tar_glimpse` is provided, only the first colour is used to fill the nodes.
#' @param shapes a character vector of length 3. any of the following: diamond, 
#' dot, star, triangle, triangleDown, hexagon, square.
#' @param background character - Hex colour codes to define the background
#' @param leg_shape_col character - Hex colour code. for tar_visnetwork an 
#' additional colour defines the colour of the shape legend items.
#'
#' @return class "visNetwork"
tar_vis_style <- function(v, colors=c("#42DCBA", "#E67F6E", "#287383"),
                          shapes=c("dot", "triangle", "triangleDown"),
                          background="#CCCCCC",
                          leg_shape_col ="#BBE3DA"){
  colors <- colors[1:3]
  lsc <- ifelse(nrow(v$x$legend$nodes)==1, colors[1], leg_shape_col)
 
  v$x$legend$nodes <- v$x$legend$nodes |>
    dplyr::mutate(color=dplyr::case_when(label=="Up to date" ~ colors[1], 
                           label=="Errored" ~ colors[2],
                           label=="Outdated" ~ colors[3],
                           TRUE~lsc),
                  shape = dplyr::case_when(label=="Function" ~ shapes[2], 
                                           label=="Object" ~ shapes[3],
                                           TRUE~shapes[1]))
  v$x$nodes <- v$x$nodes |> 
    dplyr::mutate(color = dplyr::case_when(status=="uptodate" ~ colors[1], 
                           status=="errored" ~ colors[2],
                           status=="outdated" ~ colors[3],
                           status=="none" ~ colors[1],
                           TRUE~lsc),
                  shape = dplyr::case_when(type=="function" ~ shapes[2], 
                                           type=="object" ~ shapes[3],
                                           TRUE~shapes[1]))
  v$x$background <- background
  
  v
}

example usage:

v <- tar_visnetwork()
s <- tar_glimpse()

tar_vis_style(v,
              colors=c("#42DCBA", "#E67F6E", "#287383"),
              shapes=c("star", "diamond", "hexagon"),
              background="#CCCCCC",
              leg_shape_col ="#BBE3DA")
tar_vis_style(s, "#FF9A3C", "hexagon")