1#' Render a visNetwork object from an igraph object 2#' 3#' Render a visNetwork object from an igraph object. \link{toVisNetworkData} transfrom igraph data to visNetwork data. 4#' We actually try to keep color, size and label from igraph to visNetwork. 5#' \link{visIgraph} plot directly an igraph object in visNetwork, using \link{toVisNetworkData} to extract data, and 6#' \link{visIgraphLayout} to compute layout and coordinates before rendering. 7#' 8#' 9#'@param igraph : a igraph object 10#'@param idToLabel : Boolean. Default to TRUE. Use id of nodes as label ? 11#'@param layout : Character Name of igraph layout function to use. Default to "layout_nicely" 12#'@param physics : Boolean. Default to FALSE. Enabled physics on nodes ? 13#'@param smooth : Boolean. Default to FALSE. Use smooth edges ? 14#'@param type : Character Type of scale from igrah to vis.js. "square" (default) render in a square limit by height. "full" use width and height to scale in a rectangle. 15#'@param randomSeed : Number. The nodes are randomly positioned initially. This means that the settled result is different every time. If you provide a random seed manually, the layout will be the same every time. 16#'@param layoutMatrix : in case of layout = 'layout.norm'. the 'layout' argument (A matrix with two or three columns, the layout to normalize) 17#'@param ... : Adding arguments to layout function 18#' 19#'@name visNetwork-igraph 20#' 21#'@examples 22#' 23#'\dontrun{ 24#'require(igraph) 25#'igraph_network <- graph.famous("Walther") 26#' 27#'# get data and plot : 28#'data <- toVisNetworkData(igraph_network) 29#'visNetwork(nodes = data$nodes, edges = data$edges) 30#' 31#'# or plot directly 32#'visIgraph(igraph_network) 33#' 34#'# change layout 35#'visIgraph(igraph_network, layout = "layout_in_circle") 36#' 37#'# options 38#'visIgraph(igraph_network, layout = "layout_in_circle", 39#' physics = FALSE, smooth = TRUE) 40#' 41#'# passing some info 42#'g <- graph.star(8) 43#'V(g)$color <- c("green", "grey") 44#'V(g)$size <- 1:8 *5 45#'V(g)$label <- LETTERS[1:8] 46#'V(g)$label.cex = seq(1, 2,length.out = 8) 47#'V(g)$label.color = "red" 48#'visIgraph(g, layout = "layout.circle", idToLabel = FALSE) 49#' 50#'g <- graph.full(5) 51#'E(g)$weight <- runif(ecount(g)) 52#'E(g)$width <- 1 53#'E(g)$color <- "red" 54#'E(g)[ weight < 0.5 ]$width <- 4 55#'E(g)[ weight < 0.5 ]$color <- "green" 56#'E(g)$label <- LETTERS[1:10] 57#'E(g)$label.cex = seq(1, 2,length.out = 10) 58#'E(g)$label.color = "red" 59#'visIgraph(g) 60#' 61#'# color vertices of the largest component 62#'largest_comp <- function(graph) { 63#' cl <- components(graph) 64#' V(graph)[which.max(cl$csize) == cl$membership] 65#'} 66#'g <- sample_(gnp(100, 2/100), 67#' with_vertex_(size = 3, label = ""), 68#' with_graph_(layout = layout_with_fr) 69#') 70#'giant_v <- largest_comp(g) 71#'V(g)$color <- "blue" 72#'V(g)[giant_v]$color <- "orange" 73#'plot(g) 74#'visIgraph(g) 75#'} 76#'@seealso \link{visNodes} for nodes options, \link{visEdges} for edges options, \link{visGroups} for groups options, 77#'\link{visLegend} for adding legend, \link{visOptions} for custom option, \link{visLayout} & \link{visHierarchicalLayout} for layout, 78#'\link{visPhysics} for control physics, \link{visInteraction} for interaction, \link{visNetworkProxy} & \link{visFocus} & \link{visFit} for animation within shiny, 79#'\link{visDocumentation}, \link{visEvents}, \link{visConfigure} ... 80#' 81#' @importFrom methods findFunction 82#' 83#'@export 84#'@references See online documentation \url{http://datastorm-open.github.io/visNetwork/} 85visIgraph <- function(igraph, 86 idToLabel = TRUE, 87 layout = "layout_nicely", 88 physics = FALSE, 89 smooth = FALSE, 90 type = "square", 91 randomSeed = NULL, 92 layoutMatrix = NULL, ...){ 93 94 if(!any(class(igraph) %in% "igraph")){ 95 stop("igraph must be a igraph object") 96 } 97 98 if(!type %in% c("square", "full")){ 99 stop("type must be one of 'square' or 'full'") 100 } 101 102 if(!requireNamespace("igraph", quietly = TRUE)){ 103 stop("This function need 'igraph'. Please 104 install it before.") 105 } 106 107 visdata <- toVisNetworkData(igraph, idToLabel) 108 109 directed <- FALSE 110 if(igraph::is.directed(igraph)){ 111 # if(any(duplicated(edges[, c("from", "to")]))){ 112 # 113 # }else{ 114 directed <- TRUE 115 # } 116 } 117 118 graph <- visNetwork(nodes = visdata$nodes, edges = visdata$edges) 119 120 if(nrow(visdata$nodes) > 0 | nrow(visdata$edges) > 0){ 121 graph <- graph %>% 122 visIgraphLayout(layout = layout, type = type, physics = physics, 123 smooth = smooth, randomSeed = randomSeed, 124 layoutMatrix = layoutMatrix, ...) 125 if(directed){ 126 graph <- visEdges(graph, arrows = "to") 127 } 128 } 129 130 graph 131} 132 133#'@rdname visNetwork-igraph 134#'@export 135toVisNetworkData <- function(igraph, 136 idToLabel = TRUE){ 137 if(!any(class(igraph) %in% "igraph")){ 138 stop("igraph must be a igraph object") 139 } 140 141 if(!requireNamespace("igraph", quietly = TRUE)){ 142 stop("This function need 'igraph'. Please 143 install it before.") 144 } 145 146 igraphdata <- igraph::get.data.frame(igraph, what = "both") 147 148 nodes <- igraphdata$vertices 149 if(nrow(nodes) > 0){ 150 if(!"name" %in% colnames(nodes)){ 151 nodes$id <- 1:nrow(nodes) 152 }else{ 153 colnames(nodes) <- gsub("^name$", "id", colnames(nodes)) 154 } 155 156 if("color" %in% colnames(nodes)){ 157 if(class(nodes$color) %in% c("numeric", "integer")){ 158 colnames(nodes) <- gsub("^color$", "group", colnames(nodes)) 159 } 160 } 161 162 if("label.cex" %in% colnames(nodes)){ 163 colnames(nodes) <- gsub("^label.cex$", "font.size", colnames(nodes)) 164 nodes$font.size <- nodes$font.size*40 165 } 166 167 if("label.color" %in% colnames(nodes)){ 168 colnames(nodes) <- gsub("^label.color$", "font.color", colnames(nodes)) 169 } 170 171 nodes <- nodes[, c("id", setdiff(colnames(nodes), "id")), drop = FALSE] 172 173 if(idToLabel){ 174 nodes$label <- nodes$id 175 } 176 } else { 177 nodes <- data.frame(id = c()) 178 } 179 180 edges <- igraphdata$edges 181 if(nrow(edges) > 0){ 182 if("label.cex" %in% colnames(edges)){ 183 colnames(edges) <- gsub("^label.cex$", "font.size", colnames(edges)) 184 edges$font.size <- edges$font.size*40 185 } 186 187 if("label.color" %in% colnames(edges)){ 188 colnames(edges) <- gsub("^label.color$", "font.color", colnames(edges)) 189 } 190 } else { 191 edges = data.frame(from = c(), to = c()) 192 } 193 194 list(nodes= nodes, edges = edges) 195}