R/plotd3.R

In pkggraph: A Consistent and Intuitive Platform to Explore the Dependencies of Packages on the Comprehensive R Archive Network Like Repositories

#' @title plotd3
#' @author Nikhil Singh
#' @description D3 network of a pkggraph object
#' @param x plot object generated by \code{\link{neighborhood_graph}} or
#'   \code{\link{make_neighborhood_graph}} of type igraph
#' @param height parameter to change the height of the d3 plot. Default is 500
#' @param width parameter to change the width of the d3 plot. Default is 1000
#' @examples
#' \dontrun{
#'   pkggraph::init(local = TRUE)
#'   plot_obj <- pkggraph::neighborhood_graph("hash")
#'   pkggraph::plotd3(plot_obj)
#'
#'   plot_obj <- pkggraph::neighborhood_graph(c("hash","tidytext"))
#'   pkggraph::plotd3(plot_obj, height = 750, width = 1200)
#'
#'   plot_obj <- pkggraph::neighborhood_graph(c("hash","Matrix"))
#'   pkggraph::plotd3(plot_obj)
#' }
#' @export
plotd3 <- function(x, height = 500, width = 1000){
  stopifnot(inherits(x,"pkggraph"))
  stopifnot(inherits(x[[1]], "igraph"))

  graph_object <- x[[1]]

  edgeList <- data.frame(SourceName = igraph::get.edgelist(graph_object)[,1]
                         , Weight = igraph::get.edge.attribute(graph_object,"relation")
                         , TargetName = igraph::get.edgelist(graph_object)[,2]
  )

  nodeList <- data.frame(ID = c(0:(igraph::gorder(graph_object) - 1))
                         , nName = igraph::V(graph_object)$name
                         , group = 6)

  getNodeID <- function(x){
    which(x == igraph::V(graph_object)$name) - 1L
  }

  getNodeID <- Vectorize(getNodeID)

  edgeList[["SourceID"]] <- getNodeID(edgeList[["SourceName"]])
  edgeList[["TargetID"]] <- getNodeID(edgeList[["TargetName"]])
  edgeList$value <- unclass(edgeList$Weight)

  colCodes        <- c("#E41A1C", "#1B00FF", "#4DAF4A", "#984EA3", "#FF7F00")
  names(colCodes) <- c("Depends", "Imports", "LinkingTo", "Suggests", "Enhances")
  edges_col       <- colCodes[as.character(edgeList$Weight)]

  js_code <- ' d3.select(this).select("circle")
  .transition().duration(750).attr("r", 20)'

  d3_network <- networkD3::forceNetwork(Links = edgeList
                                        , Nodes = nodeList
                                        , Source = "SourceID"
                                        , Target = "TargetID"
                                        , Value = "value"
                                        , NodeID = "nName"
                                        , Nodesize = "group"
                                        , Group = "group"
                                        , opacity = 1
                                        , zoom = TRUE
                                        , opacityNoHover = 1
                                        , arrows = TRUE
                                        , linkColour = edges_col
                                        , radiusCalculation = 5
                                        , height = height
                                        , width = width
                                        , clickAction = js_code
                                        , charge = -250
                                        , bounded = TRUE
                                        , ColourScale <- 'd3.scaleOrdinal().range(["#000000"]);'
  )
  Call <- deparse(match.call())
  if(length(Call)>1) Call <- toString(Call)

  html_code <- paste0('<h3><u>', Call , '</u> </h3>
                      <div>
                      <ul class="legend">
                      <li><span class="c1"></span>Depends</li>
                      <li><span class="c2"></span>Imports</li>
                      <li><span class="c3"></span>LinkingTo</li>
                      <li><span class="c4"></span>Suggests</li>
                      <li><span class="c5"></span>Enhances</li>
                      </ul>
                      </div>
                      <hr></hr>
                      <p>Created by pkggraph ', utils::packageVersion("pkggraph"), "</p>")

  css_code <- 'h3 {
  color: #000000;
  text-align:center;
  font-style: italic;
  font-size: 14px;
  font-family: "Helvetica";
}
p {
color: #424949 ;
text-align:center;
font-style: italic;
font-size: 14px;
font-family: "Helvetica";
}
div {
text-align:center;
}
body{background-color: #ffffff}
.legend {  list-style: none; }
.legend li { display:inline-block;}
.legend span.c1{ border: 5px solid #E41A1C; float: center; width: 12px; height: 12px; margin: 1px; }
.legend span.c2{ border: 5px solid #1B00FF; float: center; width: 12px; height: 12px; margin: 1px; }
.legend span.c3{ border: 5px solid #4DAF4A; float: center; width: 12px; height: 12px; margin: 1px; }
.legend span.c4{ border: 5px solid #984EA3; float: center; width: 12px; height: 12px; margin: 1px; }
.legend span.c5{ border: 5px solid #FF7F00; float: center; width: 12px; height: 12px; margin: 1px; }'

htmltools::browsable(htmltools::tagList(
  htmltools::tags$head(htmltools::HTML(html_code)
                       , htmltools::tags$style(css_code)
  )
  , d3_network
))
}