Display Edge Label only when Hovering Over it with Cursor - VisNetwork Igraph

前端 未结 1 1781
我寻月下人不归
我寻月下人不归 2021-01-26 03:44

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 her

相关标签:
1条回答
  • 2021-01-26 04:07

    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)
    

    0 讨论(0)
提交回复
热议问题