Nick Knauer Nick Knauer - 1 month ago 17
R Question

Display Edge Label only when Hovering Over it with Cursor - 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!

Answer

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)

enter image description here

Comments