javascript - 在 VisNetwork 的 nodesIdSelection 框中扩展维度，使标签适合而不被 chop

Question

我创建了一个效果很好的 VisNetwork 图表。我遇到的问题之一是 nodesIdSelection = TRUE 中的标签。节点 ID 相当长，并且由于下拉框的默认长度而被 chop 。这是它的样子:

我该如何扩展框的大小，使其包含所有内容而不将其切断？

完整的可重现代码如下:

library(igraph)
library(visNetwork)
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("Alpha-Bravo-Delta-BETA", "Bravo-Alpha-Delta-BETA", "Colonel-Alpha-Beta-RAT", "Demo-Test-Tester1", "Egg-Alpha-Beta-Delta-Beta", "Felix-Test-Tester-Demo", "Gasoline-Alpha-Beta-Delta-American", "Hurricane-Matthew-Example-Long-Text", "Indigo-Indigo-Indigo-Alpha", "Jab-Jabba-JabbaJabba-Delta")
rownames(B) <- c("Alpha-Bravo-Delta-BETA", "Bravo-Alpha-Delta-BETA", "Colonel-Alpha-Beta-RAT", "Demo-Test-Tester1", "Egg-Alpha-Beta-Delta-Beta", "Felix-Test-Tester-Demo", "Gasoline-Alpha-Beta-Delta-American", "Hurricane-Matthew-Example-Long-Text", "Indigo-Indigo-Indigo-Alpha", "Jab-Jabba-JabbaJabba-Delta")

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")

然后我创建了一个自定义 VisOption(我认为需要为此工作进行修改):

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 = graph.adjacency(g96e, mode = "undirected", weighted = TRUE, diag=FALSE)
i96e <- set.vertex.attribute(i96e, name = "group",value = col)
V(i96e)$title <- V(i96e)$name

VIS网络图

visIgraph(i96e, idToLabel = F, layout = "layout_nicely") %>% 
visOptions_custom(highlightNearest = TRUE, selectedBy = "group", nodesIdSelection = TRUE)

Answer 1

如visOptions 帮助中所述，您可以使用style 参数设置html 样式，从而增加大小。这是一个例子:

nodes <- data.frame(id = 1:15, label = paste("Label", 1:15),
                    group = sample(LETTERS[1:3], 15, replace = TRUE))

edges <- data.frame(from = trunc(runif(15)*(15-1))+1,
                    to = trunc(runif(15)*(15-1))+1)

visNetwork(nodes, edges) %>% 
  visOptions(nodesIdSelection = list(enabled = TRUE, 
                                     style = 'width: 300px; height: 26px;'))