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