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}