R/arcDiagramR.R

In hepplerj/arcDiagramR: Arc Diagrams for R

#' arcDiagramR
#'
#' A D3.js implementation of an arc diagram.
#'
#' @import htmlwidgets
#'
#' @export
arcDiagramR <- function(links,
                        nodes,
                        source,
                        target,
                        value,
                        nodeID,
                        nodeSize,
                        group,
                        width = NULL,
                        height = NULL,
                        colorScale = JS("d3.scale.category20b()"),
                        fontSize = 7,
                        fontFamily = "sans-serif",
                        linkColor = "#666666",
                        opacity = 0.7,
                        clickAction = NULL)
{

  # Check if data is zero indexed
  check_zero(links[, source], links[, target])

  # UI consistency
  colorScale <- as.character(colorScale)

  # Subset data from frames for network graph
  if (!is.data.frame(links)) {
    stop("Links must be a data frame class object.")
  }
  if (!is.data.frame(nodes)) {
    stop("Nodes must be a data frame class object.")
  }
  if (missing(value)) {
    links.df <- data.frame(links[, source], links[, target])
    names(links.df) <- c("source", "target")
  }
  else if (!missing(value)) {
    links.df <- data.frame(links[, source], links[, target], links[, value])
    names(links.df) <- c("source", "target", "value")
  }
  if (!missing(nodeSize)) {
    nodes.df <- data.frame(nodes[, nodeID], nodes[, group], nodes[, nodeSize])
    names(nodes.df) <- c("name", "group", "nodesize")
    nodeSize = TRUE
  } else {
    nodes.df <- data.frame(nodes[, nodeID], nodes[, group])
    names(nodes.df) <- c("name", "group")
    nodeSize = FALSE
  }
  links.df <- data.frame(links.df, color = linkColor)
  links.df$color <- as.character(links.df$color)

  # options
  options = list(
    nodeID = nodeID,
    nodeSize = nodeSize,
    group = group,
    colorScale = colorScale,
    fontSize = fontSize,
    fontFamily = fontFamily,
    opacity = opacity,
    clickAction = clickAction
  )

  # create widget
  htmlwidgets::createWidget(
    name = 'arcDiagramR',
    x = list(links = links.df, nodes = nodes.df, options = options),
    width = width,
    height = height,
    package = 'arcDiagramR'
  )
}

#' Shiny bindings for arcDiagramR
#'
#' Output and render functions for using arcDiagramR within Shiny
#' applications and interactive Rmd documents.
#'
#' @param outputId output variable to read from
#' @param width,height Must be a valid CSS unit (like \code{'100\%'},
#'   \code{'400px'}, \code{'auto'}) or a number, which will be coerced to a
#'   string and have \code{'px'} appended.
#' @param expr An expression that generates a arcDiagramR
#' @param env The environment in which to evaluate \code{expr}.
#' @param quoted Is \code{expr} a quoted expression (with \code{quote()})? This
#'   is useful if you want to save an expression in a variable.
#'
#' @name arcDiagramR-shiny
#'
#' @export
arcDiagramROutput <- function(outputId, width = '100%', height = '400px'){
  htmlwidgets::shinyWidgetOutput(outputId, 'arcDiagramR', width, height, package = 'arcDiagramR')
}

#' @rdname arcDiagramR-shiny
#' @export
renderArcDiagramR <- function(expr, env = parent.frame(), quoted = FALSE) {
  if (!quoted) { expr <- substitute(expr) } # force quoted
  htmlwidgets::shinyRenderWidget(expr, arcDiagramROutput, env, quoted = TRUE)
}