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

Question

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!

lukeA · Accepted Answer · 2016-10-07T15:31:57.817

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)

thank you for the detailed answer. So this was able to get me to remove the labels which is great while still having the `group` selection option still available but the hovering part still doesn't work. I copied your code verbatim. Any idea what may be going wrong with the hovering part of this? The variable `graph` is a matrix, think that may be the issue? — nak5120, Oct 07 '16 at 14:45
I don't know. The hovering is set by `title`, so I changed the name of the _label_ attribute in `i96e` to _title_. That way, I get the label when hovering over a node. — lukeA, Oct 07 '16 at 14:48
Ok thanks, did it work for you with the example reproducible code I provided in the beginning of the post? Just trying to figure out what the issue is @lukeA — nak5120, Oct 07 '16 at 14:54
The above code does not work because the variable `graph` is not provided. In addition, `library(igraph)` is missing. — lukeA, Oct 07 '16 at 15:21
In the example, `graph` is equivalent to `g96e` which is a matrix. I apologize for the confusion. When I tried your example with writing this beforehand: `graph<-g96e` it didn't work. Any ideas? By the way, thanks for taking the time to look into this. — nak5120, Oct 07 '16 at 15:23
Thanks, it still didn't work with the example unfortunately. Did it work for you with the example? @lukeA Should I switch `g96e` to `graph`? — nak5120, Oct 07 '16 at 15:29
I'm going to change the question by switching `graph` to `g96e` to see if that helps — nak5120, Oct 07 '16 at 15:30
It works in terms of "labels are gone" + "hover text is there". — lukeA, Oct 07 '16 at 15:32
Ok awesome, thanks! I have it working for the example I provided you. I just have to dig deeper now into why it's not working for my actual example. Thanks for taking the time to look into this! @lukeA — nak5120, Oct 07 '16 at 15:39
That works, but I just can't get the colors back. I will look into on my own though or provide a separate post @lukeA — nak5120, Oct 07 '16 at 15:44
I posted a new question here asking how to combine both the cluster color and the hover option if interested: http://stackoverflow.com/questions/39922095/adding-color-and-hover-options-to-visnetwork-igraph — nak5120, Oct 07 '16 at 16:37

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

1 Answers1

Linked