1#' Use a igraph layout for compute coordinates & fast rendering
2#'
3#' Use a igraph layout for compute coordinates and fast rendering.
4#' This function affect x and y coordinates to nodes data.frame using a igraph layout,
5#' and then render network faster with no stabilization.
6#' We set some options as : visNodes(physics = FALSE) &
7#' visEdges(smooth = FALSE) & visPhysics(stabilization= FALSE), but you can overwrite
8#' them using arguments or by add another call after visIgraphLayout
9#'
10#'@param graph : a visNetwork object
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#'@examples
20#'
21#'\dontrun{
22#'nnodes <- 200
23#'nnedges <- 400
24#'
25#'nodes <- data.frame(id = 1:nnodes)
26#'edges <- data.frame(from = sample(1:nnodes, nnedges, replace = T),
27#'                    to = sample(1:nnodes, nnedges, replace = T))
28#'
29#'# with default layout
30#'visNetwork(nodes, edges) %>%
31#'  visIgraphLayout()
32#'
33#'# use full space
34#'visNetwork(nodes, edges) %>%
35#'  visIgraphLayout(type = "full")
36#'
37#'# in circle ?
38#'visNetwork(nodes, edges) %>%
39#'  visIgraphLayout(layout = "layout_in_circle") %>%
40#'  visOptions(highlightNearest = list(enabled = T, hover = T),
41#'    nodesIdSelection = T)
42#'
43#'# keep physics with smooth curves ?
44#'visNetwork(nodes, edges) %>%
45#'  visIgraphLayout(physics = TRUE, smooth = TRUE)
46#'
47#'# fix randomSeed to keep position
48#'visNetwork(nodes, edges) %>%
49#'  visIgraphLayout(randomSeed = 123)
50#'
51#'visNetwork(nodes, edges) %>%
52#'  visIgraphLayout(randomSeed = 123)
53#'
54#'# layout_with_sugiyama
55#'nodes <- data.frame(id = 1:5)
56#'edges <- data.frame(from = c(1, 2, 2, 4), to = c(2, 3, 4, 5))
57#'
58#'visNetwork(nodes, edges) %>%
59#'  visIgraphLayout(layout = "layout_with_sugiyama", layers = c(1, 2, 3, 3, 4))
60#'
61#'visNetwork(nodes, edges) %>%
62#'  visIgraphLayout(layout = "layout_with_sugiyama")
63#'
64#'}
65#'
66#'@seealso \link{visNodes} for nodes options, \link{visEdges} for edges options, \link{visGroups} for groups options,
67#'\link{visLegend} for adding legend, \link{visOptions} for custom option, \link{visLayout} & \link{visHierarchicalLayout} for layout,
68#'\link{visPhysics} for control physics, \link{visInteraction} for interaction, \link{visNetworkProxy} & \link{visFocus} & \link{visFit} for animation within shiny,
69#'\link{visDocumentation}, \link{visEvents}, \link{visConfigure} ...
70#'
71#' @importFrom  utils getAnywhere
72#'
73#'@export
74#'@references See online documentation \url{http://datastorm-open.github.io/visNetwork/}
75visIgraphLayout <- function(graph,
76                            layout = "layout_nicely",
77                            physics = FALSE,
78                            smooth = FALSE,
79                            type = "square",
80                            randomSeed = NULL,
81                            layoutMatrix = NULL, ...){
82
83  if(any(class(graph) %in% "visNetwork_Proxy")){
84    stop("Can't use visIgraphLayout with visNetworkProxy object")
85  }
86
87  if(!any(class(graph) %in% "visNetwork")){
88    stop("graph must be a visNetwork object")
89  }
90
91  if(!all(c("nodes", "edges") %in% names(graph$x))){
92    stop("Need 'nodes' and 'edges' informations on network")
93  }
94
95  if(!type %in% c("square", "full")){
96    stop("type must be one of 'square' or 'full'")
97  }
98
99  if(!requireNamespace("igraph", quietly = TRUE)){
100    stop("This function need 'igraph' package to compute layout. Please
101         install it before.")
102  }
103
104  ctrl <- getAnywhere(layout)
105  if(length(ctrl$objs) == 0){
106    stop("Can't find '", layout, "' function. Please verify it")
107  }
108
109  if(!is.function(ctrl$objs[[1]])){
110    stop("'", layout, "' must be a function.")
111  }
112
113  igraphlayout <- list(type = type)
114
115  ig <- igraph::graph_from_data_frame(graph$x$edges[, c("from", "to")], directed = TRUE,
116                                      vertices = graph$x$nodes[, c("id", setdiff(names(graph$x$nodes), "id"))])
117
118  if(!is.null(randomSeed)){
119    set.seed(randomSeed)
120  }
121  if("layout.norm" %in% layout){
122    if (is.null(layoutMatrix)) {
123      stop("'layout.norm' requires a layout argument (a matrix with two or three columns), passed by layoutMatrix argument")
124    }
125    coord <- ctrl$objs[[1]](layout = layoutMatrix, ...)
126  } else if("layout_with_sugiyama" %in% layout){
127    coord <- ctrl$objs[[1]](graph = ig, ...)$layout
128    coord[, 2] <- max(coord[, 2]) - coord[, 2] + 1
129  } else {
130    coord <- ctrl$objs[[1]](graph = ig, ...)
131  }
132
133  graph$x$nodes$x <- coord[, 1]
134  graph$x$nodes$y <- coord[, 2]
135
136  to <- c(-1, 1)
137  from <- range(graph$x$nodes$x, na.rm = TRUE, finite = TRUE)
138  if(length(unique(from)) > 1){
139    graph$x$nodes$x <- (graph$x$nodes$x - from[1])/diff(from) * diff(to) + to[1]
140  }
141
142  from <- range(graph$x$nodes$y, na.rm = TRUE, finite = TRUE)
143  if(length(unique(from)) > 1){
144    graph$x$nodes$y <- (graph$x$nodes$y - from[1])/diff(from) * diff(to) + to[1]
145  }
146
147  # graph$x$nodes$physics = physics
148
149  graph$x$igraphlayout <- igraphlayout
150
151  graph %>% visNodes(physics = physics) %>%
152    visEdges(smooth = smooth) %>% visPhysics(stabilization = FALSE)
153}
154