if (FALSE) {  
nodes <- data.frame(id = 1:15, label = paste("Label", 1:15),
 group = sample(LETTERS[1:3], 15, replace = TRUE))
edges <- data.frame(from = trunc(runif(15)*(15-1))+1,
 to = trunc(runif(15)*(15-1))+1)
 
###################  
# highlight nearest
###################
visNetwork(nodes, edges) %>% visOptions(highlightNearest = TRUE)
visNetwork(nodes, edges) %>% visOptions(highlightNearest = list(enabled = TRUE, degree = 2))
# also when hover a node ?
visNetwork(nodes, edges) %>% visOptions(highlightNearest = list(enabled = TRUE, hover = TRUE))
# don't show nodes/edges
visNetwork(nodes, edges) %>% visOptions(highlightNearest = list(enabled = TRUE, 
 hover = TRUE, hideColor = 'rgba(200,200,200,0)'))
# Using hierarchical information
nodes = data.frame(id = 1:6, level = c(1, 2, 3, 3, 4, 2))
edges = data.frame(from = c(1, 2, 2, 4, 6), to = c(2, 3, 4, 5, 4))
visNetwork(nodes, edges) %>% visHierarchicalLayout() %>% visEdges(arrows = "to") %>% 
 visOptions(highlightNearest = list(enabled = TRUE, algorithm = "hierarchical"))
 
visNetwork(nodes, edges) %>% visHierarchicalLayout() %>% visEdges(arrows = "to") %>% 
 visOptions(highlightNearest = list(enabled = TRUE, algorithm = "hierarchical", 
   degree = list(from = 0, to = 2)))
   
##########################
# nodesIdSelection
##########################
 
visNetwork(nodes, edges) %>% 
 visOptions(highlightNearest = TRUE, nodesIdSelection = TRUE)
# add a default selected node ?
visNetwork(nodes, edges) %>% 
 visOptions(highlightNearest = TRUE, 
 nodesIdSelection = list(enabled = TRUE, selected = "1"))
 
# subset on id values & don't use labels ?
visNetwork(nodes, edges) %>% 
 visOptions(highlightNearest = TRUE, 
 nodesIdSelection = list(enabled = TRUE, 
   selected = "2", values = c(2:10), useLabels = FALSE))
 
# some style
visNetwork(nodes, edges) %>% 
 visOptions(highlightNearest = TRUE, 
 nodesIdSelection = list(enabled = TRUE, style = 'width: 200px; height: 26px;
   background: #f8f8f8;
   color: darkblue;
   border:none;
   outline:none;'))   
 
##########################
# collapse
##########################
 
nodes <- data.frame(id = 1:15, label = paste("Label", 1:15),
 group = sample(LETTERS[1:3], 15, replace = TRUE))
edges <- data.frame(from = trunc(runif(15)*(15-1))+1,
 to = trunc(runif(15)*(15-1))+1)
 
# keeping all parent node attributes  
visNetwork(nodes, edges) %>% visEdges(arrows = "to") %>%
 visOptions(collapse = TRUE)
# setting some properties  
visNetwork(nodes, edges) %>% visEdges(arrows = "to") %>%
 visOptions(collapse = list(enabled = TRUE, clusterOptions = list(shape = "square"))) 
   
# enable / disable open cluster (proxy only) : 
# visEvents(type = "off", doubleClick = "networkOpenCluster")
# visEvents(type = "on", doubleClick = "networkOpenCluster")  
 
##########################
# selectedBy
##########################
nodes <- data.frame(id = 1:15, label = paste("Label", 1:15),
 group = sample(LETTERS[1:3], 15, replace = TRUE))
edges <- data.frame(from = trunc(runif(15)*(15-1))+1,
 to = trunc(runif(15)*(15-1))+1)
 
visNetwork(nodes, edges) %>% 
 visOptions(selectedBy = "group")
 
# add a default value ?
visNetwork(nodes, edges) %>% 
 visOptions(selectedBy = list(variable = "group", selected = "A"))
# subset on values ?
visNetwork(nodes, edges) %>% 
 visOptions(selectedBy = list(variable = "group", 
   selected = "C",
   values = c("A", "C")))
 
# highlight also
visNetwork(nodes, edges) %>% 
 visOptions(selectedBy = list(variable = "group", 
   highlight = TRUE), highlightNearest = TRUE) 
     
# add some style
visNetwork(nodes, edges) %>% 
 visOptions(selectedBy = list(variable = "group", style = 'width: 200px; height: 26px;
   background: #f8f8f8;
   color: darkblue;
   border:none;
   outline:none;'))
     
# can also be on new column
nodes$sample <- sample(c("sample 1", "sample 2"), nrow(nodes), replace = TRUE)
visNetwork(nodes, edges) %>% 
 visOptions(selectedBy = "sample")
# and with multiple groups ?
nodes$group <- sample(c("group 1", "group 2", "group 1, group 2, group 3"), 
 nrow(nodes), replace = TRUE)
 
visNetwork(nodes, edges) %>% 
 visOptions(selectedBy = list(variable = "group", multiple = TRUE))
 
##########################
# manipulation
##########################
 
visNetwork(nodes, edges) %>% 
 visOptions(manipulation = TRUE)
visNetwork(nodes, edges) %>% 
 visOptions(manipulation = list(enabled = TRUE, addNode = FALSE, addEdge = FALSE))
visNetwork(nodes, edges) %>% 
 visOptions(manipulation = list(enabled = TRUE, deleteNode = FALSE, deleteEdge = FALSE))
visNetwork(nodes, edges) %>% 
 visOptions(manipulation = list(enabled = TRUE, editNode = FALSE, editEdge = FALSE))
 
# choose columns to edit
visNetwork(nodes, edges) %>% 
  visOptions(manipulation = list(enabled = TRUE, 
                                 editEdgeCols = c("label"), 
                                 editNodeCols = c("id", "label", "title", "size"), 
                                 addNodeCols = c("label", "group")))
# choose columns to edit + input html type (text, number, ...)
# https://www.w3schools.com/tags/att_input_type.asp
visNetwork(nodes, edges) %>% 
  visOptions(manipulation = list(enabled = TRUE, 
                                 editEdgeCols = c("label"), 
                                 editNodeCols = list(
                                    "text" = c("id", "label", "title"),
                                    "number" = c("size")
                                 ), 
                                 addNodeCols = c("label", "group")))
visNetwork(nodes, edges)  %>% 
 visOptions(manipulation = list(enabled = TRUE, 
                                editEdge = htmlwidgets::JS("function(data, callback) {
                                                           callback(data);
                                                           console.info('edit edge')
                                                           }")
                                    )
                                )
##########################
# collapse
##########################
visNetwork(nodes, edges) %>% 
 visEdges(arrows = "to") %>% 
 visOptions(collapse = list(enabled = TRUE, 
   clusterOptions = list(shape = "square")))
}   
Run the code above in your browser using DataLab