sta*_*oob 6 r data-visualization igraph visnetwork
我制作了以下 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）
以下是我针对这个问题想到的可能的解决方案：
选项 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 解决这个混乱问题的方法吗？
谢谢你！
尺寸是有效的，但乍一看，似乎没有。但它还没有准备好。
\n\n\n当您选择选项时，它不会触发画布内的自动调整大小功能。
\n
图形对象的自动调整大小效果很好。（你会在 gif 中看到。）
\nRStudio 中的查看器窗格并不是检查编织文件的最佳方式。编织后在浏览器中查看它......特别是如果您想进行更改。有时它似乎认为 RStudio 的所有内容都是容器大小，并且您会在屏幕上看到图形。我确定这就是我的编码方式，但这在 Safari 或 Chrome 中似乎不是问题（我没有检查其他浏览器）。
\n我尝试了多种不同的方式来触发画布大小的调整。由于尝试触发画布的调整大小/缩放范围，此代码可能会有一些冗余。（我想我删除了所有不起作用的东西。）也许有了这个，其他人就可以弄清楚该部分。
\n我使用了一些 Shiny 代码，但这没有使用Shiny 运行时。本质上，静态工作是 R，但动态元素不能在 R 中（即调整事件大小、阅读选择等）。
\n在我使用的库中，我调用了shinyRPG. 我添加并注释掉了包安装代码，因为该包不是 Cran 包。（它在 Github 上。）
我在编码中所做的假设（以及这个答案）：
\n如果这些不属实，请告诉我。
\n输出选项
\n---\ntitle: "Just for antonoyaro8"\noutput: \n flexdashboard::flex_dashboard:\n orientation: columns\n vertical_layout: fill\n---\n此代码位于 YAML 和第一个 R 代码块之间。在 RMD\xe2\x80\x93 的常规文本区域中，而不是在 R 块中。
\n<style>\nselect {\n // A reset of styles, including removing the default dropdown arrow\n appearance: none;\n background-color: transparent;\n border: none;\n padding: 0 1em 0 0;\n margin: 0;\n width: 100%;\n font-family: inherit;\n font-size: inherit;\n cursor: inherit;\n line-height: inherit;\n}\n.select {\n display: grid;\n grid-template-areas: "select";\n align-items: center;\n position: relative;\n min-width: 15ch;\n max-width: 100ch;\n border: 1px solid var(--select-border);\n border-radius: 0.25em;\n padding: 0.25em 0.5em;\n font-size: 1.25rem;\n cursor: pointer;\n line-height: 1.1;\n background-color: #fff;\n background-image: linear-gradient(to top, #f9f9f9, #fff 33%);\n}\nselect[multiple] {\n padding-right: 0; \n /* Safari will not show options unless labels fit */\n height: 50rem; // how many options show at one time\n font-size: 1rem;\n}\n#column-1 > div.containIt > div.visNetwork canvas {\n width: 100%;\n height: 80%;\n}\n.containIt {\n display: flex;\n flex-flow: row wrap;\n flex-grow: 1;\n justify-content: space-around;\n align-items: flex-start;\n align-content: space-around;\n overflow: hidden;\n height: 100%;\n width: 100%;\n margin-top: 2vw;\n height: 80vh;\n widhth: 80vw;\n overflow: hidden;\n}\n\n</style>\n接下来是第一个 R 块。您不必echo = F设置flexdashboard。
```{r setup, include=FALSE}\n\nlibrary(flexdashboard)\nlibrary(visNetwork)\nlibrary(htmltools)\nlibrary(igraph)\nlibrary(tidyverse)\nlibrary(shinyRPG) # remotes::install_github("RinteRface/shinyRPG")\n\n```\n下一部分本质上是您的代码。我在调用的最终版本中更改了一些内容以创建vizNetwork.
```{r dataStuff}\n\nset.seed(123)\nn=15\ndata = data.frame(tibble(d = paste(1:n)))\n\nrelations = data.frame(tibble(\n from = sample(data$d),\n to = lead(from, default=from[1]),\n))\ndata$name = c("new york", "chicago", "los angeles", "orlando", "houston", "seattle", "washington", "baltimore", "atlanta", "las vegas", "oakland", "phoenix", "kansas", "miami", "newark" )\n\ngraph = graph_from_data_frame(relations, directed=T, vertices = data) \n\n#red circle: starting point and final point\nV(graph)$color <- ifelse(data$d == relations$from[1], "red", "orange")\n\na = visIgraph(graph) \n\nm_1 = 1\nm_2 = 23.6\n\na = toVisNetworkData(graph) %>%\n c(., list(main = paste0("Trip ", m_1, " : "), \n submain = paste0 (m_2, "KM") )) %>%\n do.call(visNetwork, .) %>%\n visIgraphLayout(layout = "layout_in_circle") %>% \n visEdges(arrows = 'to')\n\n# collect the correct order\ndf2 <- data %>% \n mutate(d = as.numeric(d),\n nuname = factor(a$x$edges$from, \n levels = unlist(data$name))) %>%\n arrange(nuname) %>% \n select(d) %>% unlist(use.names = F)\n# [1] 11 5 2 8 7 6 10 14 15 4 12 9 13 3 1 \nV(graph)$name = data$label = paste0(df2, "\\n", data$name)\na = visIgraph(graph) \n\nm_1 = 1\nm_2 = 23.6\na = toVisNetworkData(graph) %>%\n c(., list(main = list(text = paste0("Trip ", m_1, " : "), \n style = "font-family: Georgia; font-size: 100%; font-weight: bold; text-align:center;"),\n submain = list(text = paste0(m_2, "KM"),\n style = "font-family: Georgia; font-size: 100%; text-align:center;"))) %>%\n do.call(visNetwork, .) %>%\n visInteraction(navigationButtons = TRUE) %>%\n visIgraphLayout(layout = "layout_in_circle") %>% \n visEdges(arrows = 'to') %>% \n visOptions(width = "100%", height = "80%", autoResize = T)\n\na[["sizingPolicy"]][["knitr"]][["figure"]] <- FALSE\n\ny = x = w = v = u = t = s = r = q = p = o = n = m = l = k = j = i = h = g = f = e = d = c = b = a\n\n```\n在最后一个代码块和下一个代码块之间是下一部分的位置。这将创建左列，即多选框所在的位置。（这不在代码块中。）
\nColumn {data-width=200}\n-----------------------------------------------------------------------\n\n### Select Options\n\nYou can select one or more options from the list. \n否，构建选择框并附加将触发更改的函数。这部分需要修改。在此命名用户在屏幕上看到的选项。（letters[1:25]在此代码中。）
您的对象名称不必与此处的名称匹配。不过，它们确实需要保持相同的顺序。
\n```{r selectiver}\ntagSel <- rpgSelect(\n "selectBox", # don't change this (connected)\n "Selections:", # visible on HTML; change away or set to ""\n c(setNames(1:25, letters[1:25])), # left is values, right is labels\n multiple = T # all multiple selections\n) # other attributes controlled by css at the top\n\ntagSel$attribs$class <- 'select select--multiple' # connect styles\ntagSel$children[[2]]$attribs$class <- "mutli-select" # connect styles\ntagSel$children[[2]]$attribs$onchange <- "getOps(this)" # connect the JS function\n\ntagSel\n\n```\n然后在前一个块和下一个块之间（不在一个块中）：
\nColumn\n-----------------------------------------------------------------------\n\n<div class="containIt">\n现在调用你的图表。
\n```{r notNow, include=T}\n\na\nb\nc\nd\ne\nf\ng\nh\ni\nj\nk\nl\nm\nn\no\np\nq\nr\ns\nt\nu\nv\nw\nx\ny\n\n```\n关闭该块之后的 div 标签：
\n</div>\n这开始得很好而且很整洁......但是经过大量的尝试和错误\xe2\x80\x93WYSIWYG。\n有效的评论也在此过程中的某个地方失败了。如果对什么作用有疑问，请告诉我。
\n如果您在 R Markdown 中运行该块（在“源”窗格中），则该块不会执行任何操作。要执行 JS，您必须knit.
```{r pickMe,results='asis',engine='js'}\n\n//remove inherent knitr element-- after using mutlti-select starts harboring space\nbyeknit = document.querySelector('#column-1 > div.containIt > div.knitr-options');\nbyeknit.remove(1);\n\n// Reset Sizing of Widgets\nh = document.querySelector('#column-1 > div.containIt').clientHeight;\nw = document.querySelector('#column-1 > div.containIt').clientWidth;\nhw = h * w;\n\ncont = document.querySelectorAll('#column-1 > div.containIt > div');\n\nnewHeight = Math.floor(Math.sqrt(hw/cont.length)) * .85;\n\nfor(i = 0; i < cont.length; ++i){\n cont[i].style.height = newHeight + 'px';\n cont[i].style.width = newHeight + 'px';\n cn = cont[i].childNodes;\n if(cn.length > 0){\n th = cn[0].clientHeight + cn[1].clientHeight;\n console.log("canvas found");\n mb = newheight - th;\n cn[5].style.height = mb + 'px'; //canvas control attempt\n }\n}\n\nfunction resizePlease(count) { //resize plots based on selections\n // screen may have resized**\n h = document.querySelector('#column-1 > div.containIt').clientHeight;\n w = document.querySelector('#column-1 > div.containIt').clientWidth;\n hw = h * w; // get the area\n \n // based on selected count** these should fit--- \n // RStudio!\n newHeight = Math.floor(Math.sqrt(hw/count)) * .85; \n for(i = 0; i < graphy.length; ++i){\n graphy[i].style.height = newHeight + 'px';\n graphy[i].style.width = newHeight + 'px';\n gcn = graphy[i].childNodes;\n if(cn.length > 0){\n th = gcn[0].clientHeight + gcn[1].clientHeight;\n mb = newHeight - th;\n gcn[5].style.height = mb + 'px'; //canvas control attempt\n canYouPLEASElisten = graphy[i].querySelector('canvas');\n canYouPLEASElisten.style.height = mb + 'px'; //trigger zoom extent!!\n canYouPLEASElisten.style.height = '100%';\n }\n }\n}\n\n\n// Something selected triggers this function\nfunction getOps(sel) { \n //get ref to select list and display text box\n graphy = document.querySelectorAll('#column-1 div.visNetwork');\n count = 0; // reset count of selected vis\n // loop through selections\n for(i = 0; i < sel.length; i++) {\n opt = sel.options[i];\n if ( opt.selected ) {\n count++\n graphy[i].style.display = 'block';\n console.log(opt + "selected");\n console.log(count + " options selected");\n } else {\n graphy[i].style.display = 'none';\n }\n }\n resizePlease(count); \n}\n\n```\n如果您转到开发人员工具控制台，您将能够看到在进行选择时选择了多少个选项以及哪些选项。这样，如果出现诸如逆序之类的奇怪情况（我怀疑但无法验证），您将按照您的预期看到发生或未发生的情况。无论您在哪里看到console.log，都在向控制台发送消息，这样您就可以观察正在发生的情况。
如果背景中有任何颜色、自定义或其他您想要的颜色，请告诉我。我也可以帮助完成这部分。目前，仪表板的颜色是默认颜色。
\n