javascript - 仅当光标悬停在边缘标签上时才显示边缘标签 - VisNetwork Igraph

Question

引用我之前的一篇文章，其中包含完整的可重现代码:VisNetwork from IGraph - Can't Implement Cluster Colors to Vertices

我的目标是更改 visNetwork 包图中的一些可视化选项。目前放大时标签太多，很难区分哪个节点属于哪个标签。是否可以从 visNetwork 图中删除标签，并且仅当我将鼠标悬停在节点上时才显示标签？

我尝试设置 idToLabel = FALSE，但当我包含 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")

我觉得我几乎完成了我想要对这个项目做的事情，但这只是最后一步，仅当光标悬停在节点上时才显示节点似乎是问题所在。

任何帮助都会很棒，谢谢!

Answer 1

你可以做

names(vertex_attr(i96e))[which(names(vertex_attr(i96e)) == "label")] <- "title"
visIgraph(i96e, idToLabel = F, layout = "layout_nicely") %>%
visOptions_custom(highlightNearest = TRUE, selectedBy = "group") 

与 visOptions_custom 蜜蜂:

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
}

和i96e正在:

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)