修复图表上混乱的标题

我制作了以下 25 个网络图（为了简单起见，所有这些图都是复制品 - 实际上，它们都会有所不同）：

library(tidyverse)
library(igraph)


set.seed(123)
n=15
data = data.frame(tibble(d = paste(1:n)))

relations = data.frame(tibble(
  from = sample(data$d),
  to = lead(from, default=from[1]),
))

data$name = c("new york", "chicago", "los angeles", "orlando", "houston", "seattle", "washington", "baltimore", "atlanta", "las vegas", "oakland", "phoenix", "kansas", "miami", "newark" )

graph = graph_from_data_frame(relations, directed=T, vertices = data) 

V(graph)$color <- ifelse(data$d == relations$from[1], "red", "orange")

plot(graph, layout=layout.circle, edge.arrow.size = 0.2, main = "my_graph")

library(visNetwork)

    a = visIgraph(graph)  

m_1 = 1
m_2 = 23.6

 a = toVisNetworkData(graph) %>%
    c(., list(main = paste0("Trip ", m_1, " : "), submain = paste0 (m_2, "KM") )) %>%
    do.call(visNetwork, .) %>%
    visIgraphLayout(layout = "layout_in_circle") %>% 
    visEdges(arrows = 'to') 



y = x = w = v = u = t = s = r = q  = p = o = n = m = l = k = j = i = h = g = f = e = d = c = b = a

我想将它们“平铺”为 5 x 5 ：因为这些是交互式 html 图 - 我使用了以下命令：

library(manipulateWidget)
library(htmltools)

ff = combineWidgets(y , x , w , v , u , t , s , r , q  , p , o , n , m , l , k , j , i , h , g , f , e , d , c , b , a)

htmltools::save_html(html = ff, file = "widgets.html")

我找到了如何为每个单独的图表添加缩放选项：

 a = toVisNetworkData(graph) %>%
    c(., list(main = paste0("Trip ", m_1, " : "), submain = paste0 (m_2, "KM") )) %>%
    do.call(visNetwork, .) %>%
    visIgraphLayout(layout = "layout_in_circle") %>%  
    visInteraction(navigationButtons = TRUE) %>% 
    visEdges(arrows = 'to') 

y = x = w = v = u = t = s = r = q  = p = o = n = m = l = k = j = i = h = g = f = e = d = c = b = a

ff = combineWidgets(y , x , w , v , u , t , s , r , q  , p , o , n , m , l , k , j , i , h , g , f , e , d , c , b , a)

htmltools::save_html(html = ff, file = "widgets.html")

[![在此处输入图像描述][1]][1]

但现在“缩放”选项和“标题”已经“混乱”了所有图表！

我认为最好将所有这些图表“堆叠”在一起并将每个图表保存为“组类型” - 然后根据需要隐藏/取消隐藏：

visNetwork(data, relations) %>% 
 visOptions(selectedBy = "group")

• 我们能否将所有 25 个图表放在一页上，然后“缩放”每个单独的图表以更好地查看它（例如，在屏幕一角只有一组适用于所有图表的缩放/导航按钮）？

• 有没有办法阻止标题与图表重叠？

• 我们能否将所有 25 个图表放在一页上，然后通过“选中”选项菜单按钮来“隐藏”各个图表？ （就像本页的最后一个例子：https://datastorm-open.github.io/visNetwork/options.html https://datastorm-open.github.io/visNetwork/options.html)

以下是我针对这个问题想到的可能的解决方案：

• 选项 1：（所有图表都有一个缩放/导航选项，并且没有杂乱的标签）

• 选项2：（将来，每个“旅行”都会不同——“旅行”将包含相同的节点，但具有不同的边连接和不同的标题/副标题。）

我知道这种选择方式（“选项 2”）可以使用以下代码进行：

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(selectedBy = "group")

但我不确定如何针对一组预先存在的“visNetwork”图调整上述代码。例如，假设我已经有“visNetwork”图“a、b、c、d、e” - 我如何“将它们堆叠在一起”并使用“选择菜单”“随机播放它们”，就像在上面的代码？

[![在此处输入图像描述][4]][4]

有人可以告诉我一种使用选项 1 和选项 2 解决这个混乱问题的方法吗？

谢谢你！

虽然我的解决方案并不完全是您所描述的Option 2，很接近。我们用combineWidgets()创建一个具有单列和行高的网格，其中一个图表覆盖大部分屏幕高度。我们在每个小部件实例之间插入一个链接，单击时向下滚动浏览器窗口以显示下图。

让我知道这是否适合您。应该可以根据浏览器窗口大小自动调整行大小。目前，这取决于浏览器窗口高度约为 1000 像素。

我稍微修改了您的图形创建代码并将其包装在一个函数中。这使我们能够轻松创建 25 个外观不同的图表。这样测试生成的 HTML 文件会更有趣！函数定义后面是创建一个list然后我们输入的 HTML 对象的数量combineWidgets().

library(visNetwork)
library(tidyverse)
library(igraph)
library(manipulateWidget)
library(htmltools)

create_trip_graph <-
  function(x, distance = NULL) {
    n <- 15
    data <- tibble(d = 1:n,
                   name =
                     c(
                       "new york",
                       "chicago",
                       "los angeles",
                       "orlando",
                       "houston",
                       "seattle",
                       "washington",
                       "baltimore",
                       "atlanta",
                       "las vegas",
                       "oakland",
                       "phoenix",
                       "kansas",
                       "miami",
                       "newark"
                     ))
    
    relations <-  tibble(from = sample(data$d),
                         to = lead(from, default = from[1]))    
    graph <-
      graph_from_data_frame(relations, directed = TRUE, vertices = data)
    
    V(graph)$color <-
      ifelse(data$d == relations$from[1], "red", "orange")
    
    if (is.null(distance))
      # This generates a random distance value if none is 
      # specified in the function call. Values are just for 
      # demonstration, no actual distances are calculated.
      distance <- sample(seq(19, 25, .1), 1)
    
    toVisNetworkData(graph) %>%
      c(., list(
        main = paste0("Trip ", x, " : "),
        submain = paste0(distance, "KM")
      )) %>%
      do.call(visNetwork, .) %>%
      visIgraphLayout(layout = "layout_in_circle") %>%
      visInteraction(navigationButtons = TRUE) %>%
      visEdges(arrows = 'to')
  }

comb_vgraphs <- lapply(1:25, function (x) list(
  create_trip_graph(x),
  htmltools::a("NEXT TRIP", 
               onclick = 'window.scrollBy(0,950)', 
               style = 'color:blue; text-decoration:underline;')))  %>%
  unlist(recursive = FALSE)


ff <-
  combineWidgets(
    list = comb_vgraphs,
    ncol = 1,
    height = 25 * 950,
    rowsize = c(24, 1)
  )

htmltools::save_html(html = ff, file = "widgets.html")

如果您希望每行有 5 个网络映射，则代码会变得更加复杂，并且还可能导致用户可能必须进行水平滚动才能看到所有内容的情况，这是您在创建时通常要避免的情况HTML 页面。以下是每行 5 个地图解决方案的代码：

comb_vgraphs2 <- lapply(1:25, function(x) {
  a <- list(create_trip_graph(x))
  # We detect whenever we are creating the 5th, 10th, 15th etc. network map
  # and add the link after that one.
  if (x %% 5 == 0 & x < 25) a[[2]] <- htmltools::a("NEXT 5 TRIPS", 
                                          onclick = 'window.scrollBy(0,500)', 
                                          style = 'color:blue; text-decoration:underline;')
  a
}) %>%
  unlist(recursive = FALSE)

ff2 <-
  combineWidgets(
    list = comb_vgraphs2,
    ncol = 6, # We need six columns, 5 for the network maps 
              # and 1 for the link to scroll the page.
    height = 6 * 500,
    width = 1700
    #rowsize = c(24, 1)
  )

# We need to add some white space in for the scrolling by clicking the link to 
# still work for the last row.
ff2$widgets[[length(ff2$widgets) + 1]] <- htmltools::div(style = "height: 1000px;")

htmltools::save_html(html = ff2, file = "widgets2.html")

一般来说，我建议你尝试一下height and width, ncol and nrow的论据combineWidgets()以获得满意的解决方案。我构建此项目时的策略是首先创建一个没有滚动链接的网格，然后在正确设置网格后将其添加进去。