仅当使用光标悬停在其上时显示边缘标签 - VisNetwork Igraph [英] Display Edge Label only when Hovering Over it with Cursor - VisNetwork Igraph
本文介绍了仅当使用光标悬停在其上时显示边缘标签 - VisNetwork Igraph的处理方法，对大家解决问题具有一定的参考价值，需要的朋友们下面随着小编来一起学习吧！
问题描述
回顾我之前的一篇文章，其中包含完整的可重现代码：
Referring back to one of my previous post which contains the full reproducible code: VisNetwork from IGraph - Can't Implement Cluster Colors to Vertices
My goal here is to change some of the visualization options from the visNetwork package graph. There are too many labels currently when I zoom in and it is very tough to distinguish which node belongs to which label. Is it possible to remove the labels from the visNetwork graph, and only display the labels when I hover over a node?
I have tried setting idToLabel = FALSE, but the labels come back when I include selectedBy = "group".
library('visNetwork')
col = c("#80FF00FF", "#FF0000FF", "#FF0000FF", "#00FFFFFF",
"#FF0000FF", "#8000FFFF", "#FF0000FF", "#FF0000FF",
"#FF0000FF", "#FF0000FF")
i96e = graph.adjacency(g96e, mode = "undirected", weighted = TRUE, diag=FALSE)
i96e <- set.vertex.attribute(i96e, name = "group",value = col)
visIgraph(i96e, idToLabel = TRUE, layout = "layout_nicely") %>%
visOptions(highlightNearest = TRUE, selectedBy = "group")
I feel like I practically completed what I wanted to do with this project, but it is just this last final step of only displaying the nodes when hovering over it with the cursor seems to be the issue.
Any help would be great, thanks!
解决方案
You could do
names(vertex_attr(i96e))[which(names(vertex_attr(i96e)) == "label")] <- "title"
visIgraph(i96e, idToLabel = F, layout = "layout_nicely") %>%
visOptions_custom(highlightNearest = TRUE, selectedBy = "group")
with visOptions_custom beeing:
visOptions_custom <- function (graph, width = NULL, height = NULL, highlightNearest = FALSE,
nodesIdSelection = FALSE, selectedBy = NULL, autoResize = NULL,
clickToUse = NULL, manipulation = NULL)
{
if (!any(class(graph) %in% c("visNetwork", "visNetwork_Proxy"))) {
stop("graph must be a visNetwork or a visNetworkProxy object")
}
options <- list()
options$autoResize <- autoResize
options$clickToUse <- clickToUse
if (is.null(manipulation)) {
options$manipulation <- list(enabled = FALSE)
}
else {
options$manipulation <- list(enabled = manipulation)
}
options$height <- height
options$width <- width
if (!is.null(manipulation)) {
if (manipulation) {
graph$x$datacss <- paste(readLines(system.file("htmlwidgets/lib/css/dataManipulation.css",
package = "visNetwork"), warn = FALSE), collapse = "\n")
}
}
if (!"nodes" %in% names(graph$x) && any(class(graph) %in%
"visNetwork")) {
highlight <- list(enabled = FALSE)
idselection <- list(enabled = FALSE)
byselection <- list(enabled = FALSE)
}
else {
highlight <- list(enabled = FALSE, hoverNearest = FALSE,
degree = 1, algorithm = "all")
if (is.list(highlightNearest)) {
if (any(!names(highlightNearest) %in% c("enabled",
"degree", "hover", "algorithm"))) {
stop("Invalid 'highlightNearest' argument")
}
if ("algorithm" %in% names(highlightNearest)) {
stopifnot(highlightNearest$algorithm %in% c("all",
"hierarchical"))
highlight$algorithm <- highlightNearest$algorithm
}
if ("degree" %in% names(highlightNearest)) {
highlight$degree <- highlightNearest$degree
}
if (highlight$algorithm %in% "hierarchical") {
if (is.list(highlight$degree)) {
stopifnot(all(names(highlight$degree) %in%
c("from", "to")))
}
else {
highlight$degree <- list(from = highlight$degree,
to = highlight$degree)
}
}
if ("hover" %in% names(highlightNearest)) {
stopifnot(is.logical(highlightNearest$hover))
highlight$hoverNearest <- highlightNearest$hover
}
if ("enabled" %in% names(highlightNearest)) {
stopifnot(is.logical(highlightNearest$enabled))
highlight$enabled <- highlightNearest$enabled
}
}
else {
stopifnot(is.logical(highlightNearest))
highlight$enabled <- highlightNearest
}
if (highlight$enabled && any(class(graph) %in% "visNetwork")) {
if (!"label" %in% colnames(graph$x$nodes)) {
#graph$x$nodes$label <- as.character(graph$x$nodes$id)
}
if (!"group" %in% colnames(graph$x$nodes)) {
graph$x$nodes$group <- 1
}
}
idselection <- list(enabled = FALSE, style = "width: 150px; height: 26px")
if (is.list(nodesIdSelection)) {
if (any(!names(nodesIdSelection) %in% c("enabled",
"selected", "style", "values"))) {
stop("Invalid 'nodesIdSelection' argument. List can have 'enabled', 'selected', 'style', 'values'")
}
if ("selected" %in% names(nodesIdSelection)) {
if (any(class(graph) %in% "visNetwork")) {
if (!nodesIdSelection$selected %in% graph$x$nodes$id) {
stop(nodesIdSelection$selected, " not in data. nodesIdSelection$selected must be valid.")
}
}
idselection$selected <- nodesIdSelection$selected
}
if ("enabled" %in% names(nodesIdSelection)) {
idselection$enabled <- nodesIdSelection$enabled
}
else {
idselection$enabled <- TRUE
}
if ("style" %in% names(nodesIdSelection)) {
idselection$style <- nodesIdSelection$style
}
}
else if (is.logical(nodesIdSelection)) {
idselection$enabled <- nodesIdSelection
}
else {
stop("Invalid 'nodesIdSelection' argument")
}
if (idselection$enabled) {
if ("values" %in% names(nodesIdSelection)) {
idselection$values <- nodesIdSelection$values
if (length(idselection$values) == 1) {
idselection$values <- list(idselection$values)
}
if ("selected" %in% names(nodesIdSelection)) {
if (!idselection$selected %in% idselection$values) {
stop(idselection$selected, " not in data/selection. nodesIdSelection$selected must be a valid value.")
}
}
}
}
byselection <- list(enabled = FALSE, style = "width: 150px; height: 26px",
multiple = FALSE)
if (!is.null(selectedBy)) {
if (is.list(selectedBy)) {
if (any(!names(selectedBy) %in% c("variable",
"selected", "style", "values", "multiple"))) {
stop("Invalid 'selectedBy' argument. List can have 'variable', 'selected', 'style', 'values', 'multiple'")
}
if ("selected" %in% names(selectedBy)) {
byselection$selected <- as.character(selectedBy$selected)
}
if (!"variable" %in% names(selectedBy)) {
stop("'selectedBy' need at least 'variable' information")
}
byselection$variable <- selectedBy$variable
if ("style" %in% names(selectedBy)) {
byselection$style <- selectedBy$style
}
if ("multiple" %in% names(selectedBy)) {
byselection$multiple <- selectedBy$multiple
}
}
else if (is.character(selectedBy)) {
byselection$variable <- selectedBy
}
else {
stop("Invalid 'selectedBy' argument. Must a 'character' or a 'list'")
}
if (any(class(graph) %in% "visNetwork_Proxy")) {
byselection$enabled <- TRUE
if ("values" %in% names(selectedBy)) {
byselection$values <- selectedBy$values
}
if ("selected" %in% names(byselection)) {
byselection$selected <- byselection$selected
}
}
else {
if (!byselection$variable %in% colnames(graph$x$nodes)) {
warning("Can't find '", byselection$variable,
"' in node data.frame")
}
else {
byselection$enabled <- TRUE
byselection$values <- unique(graph$x$nodes[,
byselection$variable])
if (byselection$multiple) {
byselection$values <- unique(gsub("^[[:space:]]*|[[:space:]]*$",
"", do.call("c", strsplit(as.character(byselection$values),
split = ","))))
}
if (any(c("integer", "numeric") %in% class(graph$x$nodes[,
byselection$variable]))) {
byselection$values <- sort(byselection$values)
}
else {
byselection$values <- sort(as.character(byselection$values))
}
if ("values" %in% names(selectedBy)) {
byselection$values <- selectedBy$values
}
if ("selected" %in% names(byselection)) {
if (!byselection$selected %in% byselection$values) {
stop(byselection$selected, " not in data/selection. selectedBy$selected must be a valid value.")
}
byselection$selected <- byselection$selected
}
if (!"label" %in% colnames(graph$x$nodes)) {
graph$x$nodes$label <- ""
}
if (!"group" %in% colnames(graph$x$nodes)) {
graph$x$nodes$group <- 1
}
}
}
}
}
x <- list(highlight = highlight, idselection = idselection,
byselection = byselection)
if (highlight$hoverNearest) {
graph <- visInteraction(graph, hover = TRUE)
}
if (any(class(graph) %in% "visNetwork_Proxy")) {
data <- list(id = graph$id, options = options)
graph$session$sendCustomMessage("visShinyOptions", data)
if (missing(highlightNearest)) {
x$highlight <- NULL
}
if (missing(nodesIdSelection)) {
x$idselection <- NULL
}
if (missing(selectedBy)) {
x$byselection <- NULL
}
data <- list(id = graph$id, options = x)
graph$session$sendCustomMessage("visShinyCustomOptions",
data)
}
else {
graph$x <- visNetwork:::mergeLists(graph$x, x)
graph$x$options <- visNetwork:::mergeLists(graph$x$options, options)
}
graph
}
and i96e beeing:
B = matrix(
c(1, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 47, 3, 0, 3, 0, 1, 10, 13, 5,
0, 3, 19, 0, 1, 0, 1, 7, 3, 1,
0, 0, 0, 3, 0, 0, 0, 0, 0, 0,
0, 3, 1, 0, 32, 0, 0, 3, 2, 1,
0, 0, 0, 0, 0, 2, 0, 0, 0, 0,
0, 1, 1, 0, 0, 0, 2, 1, 1, 0,
0, 10, 7, 0, 3, 0, 1, 90, 12, 4,
0, 13, 3, 0, 2, 0, 1, 12, 52, 4,
0, 5, 1, 0, 1, 0, 0, 4, 4, 18),
nrow=10,
ncol=10)
colnames(B) <- c("A", "B", "C", "D", "E", "F", "G", "H", "I", "J")
rownames(B) <- c("A", "B", "C", "D", "E", "F", "G", "H", "I", "J")
g96e = t(B) %*% B
i96e = graph.adjacency(g96e, mode = "undirected", weighted = TRUE, diag=FALSE)
V(i96e)$label = V(i96e)$name
V(i96e)$label.color = rgb(0,0,.2,.8)
V(i96e)$label.cex = .1
V(i96e)$size = 2
V(i96e)$color = rgb(0,0,1,.5)
V(i96e)$frame.color = V(i96e)$color
fc<-fastgreedy.community(i96e, merges=TRUE, modularity=TRUE,
membership=TRUE, weights=E(i96e)$weight)
colors <- rainbow(max(membership(fc)))
col = c("#80FF00FF", "#FF0000FF", "#FF0000FF", "#00FFFFFF",
"#FF0000FF", "#8000FFFF", "#FF0000FF", "#FF0000FF",
"#FF0000FF", "#FF0000FF")
i96e <- set.vertex.attribute(i96e, name = "group",value = col)
这篇关于仅当使用光标悬停在其上时显示边缘标签 - VisNetwork Igraph的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！
查看全文
