#' @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
))
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.