R/vt_nodes.R

In uRosConf/voronoiTreemap: Voronoi Treemaps with Added Interactivity by Shiny

#' vt_create_node
#'
#' @param total_lab name of the total level
#'
#' @return a Node
#' @export
#'
#' @examples
#' vt_create_node("Total")
vt_create_node <- function (total_lab = "Total") {
  stopifnot(is_scalar_character(total_lab))
  node <- Node$new(total_lab)
  node
}

#' vt_add_nodes
#'
#' add (sub)nodes to a node generated by \code{\link{vt_create_node}} or returned
#' from  \code{\link{vt_add_nodes}}
#'
#' @param node a node object
#' @param refnode name of the reference node
#' @param node_names new node names
#' @param colors optionally a vector of colors matching the length of \code{node_names}
#' @param weights optionally a vector of weights matching the length of \code{node_names}
#' @param codes optionally a vector of short labels matching the length of \code{node_names}
#'
#' @return a Node object
#' @export
#'
#' @examples
#' n <- vt_create_node("Total")
#' n <- vt_add_nodes(n, refnode="Total",node_names=c("Asia","Europe"), colors=c("red","blue"))
#' n <- vt_add_nodes(n, refnode="Asia",node_names=c("China","Thailand"),
#'   weights=c(0.5, 0.8), codes=c("CN","TH"))
#' n <- vt_add_nodes(n, refnode="Europe",node_names=c("Netherlands","Austria"),
#'   weights=c(0.9, 1.1), codes=c("NL","AT"))
#' print(n, "weight", "code", "color")
vt_add_nodes <- function(node, refnode, node_names, colors=NULL, weights=NULL, codes=NULL) {
  cur_node <- FindNode(node, refnode)
  if (is.null(cur_node)) {
    return(NULL)
  }

  stopifnot(is.character(node_names))
  if (!is.null(colors)) {
    stopifnot(is.character(colors), length(colors)==length(node_names))
  }
  if (!is.null(weights)) {
    stopifnot(is.numeric(weights), length(weights)==length(node_names))
  }
  if (!is.null(codes)) {
    stopifnot(is.character(codes), length(codes)==length(node_names))
  }

  col <- ww <- cc <- NULL
  for (i in seq_along(node_names)) {
    lab <- node_names[i]
    if (!is.null(FindNode(cur_node, lab))) {
      cat("Node", lab, "already exists under", shQuote(refnode), "--> skipping\n")
    }
    else {
      if(!is.null(weights)) {
        ww <- weights[i]
      }
      if(!is.null(colors)) {
        col <- colors[i]
      }
      if(!is.null(codes)) {
        cc <- codes[i]
      }
      cur_node$AddChild(lab, color=col, weight=ww, code=cc)
    }
  }
  return(node)
}