我有一个闪亮的应用程序，它从networkD3包创建一个sankeyNetwork，它接受输入以更新用于网络的数据，并根据存在的节点数量调整自身大小。我上周发布了一个问题，并获得了应用反应高度参数所需的帮助。
我之前发现这个问题是为了解决仅从 Firefox 查看时输出很小的问题。我已经在他们的问题页面上阅读了一下，这似乎仍然是开放的。
我正在寻求帮助的问题是，当我配对这两个解决方案时，该应用程序无法按预期工作。在我的实际应用程序中，当我更新其中一个输入时，高度会更新，但用于创建图表的数据是相同的。再次更新输入后，关系图将消失并保持消失状态，直到应用终止。
我在这里重新创建了一个玩具示例。这个行为略有不同，因为在收到更新的输入时，数据和大小都会更新(在我的实际中，只有大小被更新(，但确实存在消失的行为。我无法重新创建不更新的数据，但我希望修复该修复程序将解决另一个问题。
library(shiny)
library(dplyr)
library(networkD3)
ui <- fluidPage(
selectInput(inputId = "plot",
label = "plot",
choices = c("plota", "plotb")),
uiOutput("diagram_dynamic")
)
server <- function(input, output) {
dat <- data.frame(plot = c("plota", "plota", "plotb", "plotb", "plotb"),
start = c("a", "b", "a", "b", "c"),
finish = c("x", "x", "y", "y", "z"),
count = c(12, 4, 5, 80, 10))
temp_dat <- reactive({
filter(dat, plot == input$plot)
})
links <- reactive({
temp_dat <- temp_dat()
data.frame(source = temp_dat$start,
target = temp_dat$finish,
value = temp_dat$count)
})
nodes <- reactive({
temp_links_1 <- links()
data.frame(name = c(as.character(temp_links_1$source),
as.character(temp_links_1$target))#,
) %>%
unique()
})
links2 <- reactive({
temp_links <- links()
temp_nodes <- nodes()
temp_links$IDsource <- match(temp_links$source, temp_nodes$name) - 1
temp_links$IDtarget <- match(temp_links$target, temp_nodes$name) - 1
temp_links
})
output$diagram <- renderSankeyNetwork({
sankeyNetwork(
Links = links2(),
Nodes = nodes(),
Source = "IDsource",
Target = "IDtarget",
Value = "value",
NodeID = "name",
sinksRight = FALSE,
fontSize = 13
) %>%
htmlwidgets::onRender('document.getElementsByTagName("svg")[0].setAttribute("viewBox", "")')
# commenting out the above line (and the pipe above that) allows the app to work as expected
})
output$diagram_dynamic <- renderUI({
height_val <- as.character(100*nrow(nodes()))
sankeyNetworkOutput("diagram", height = height_val)
})
}
shinyApp(ui = ui, server = server)
从链接的问题中删除 htmlwidgets：：onRender(( 调用允许应用程序按预期执行，并根据输入更新数据和大小。将其保留，两者都会更新，但在第二次切换后，图表消失了。
尝试使用这个...
htmlwidgets::onRender('function(el) { el.getElementsByTagName("svg")[0].removeAttribute("viewBox") }')
从技术上讲，根据其文档，您传递给htmlwidgets::onRender的 JS "必须是返回函数的有效 JavaScript 表达式"(尽管 JS 代码以任何一种方式运行，因此您会看到效果(，这似乎触发了来自 Shiny 的"ID 图的重复绑定"错误，这似乎是导致绘图消失的原因。您可以使用htmlwidgets::onRender('console.log("test")')演示相同的错误/问题
我还将其更改为仅获取小部件节点内的元素，以便它更有可能获得正确的 SVG(例如，如果页面上有多个 SVG(，并且我使用removeAttribute("viewBox")而不是setAttribute("viewBox", "")，这似乎更直接的方法。
更新 2020.04.02
和/或使用querySelector以避免需要使用[0]来选择列表中的第一个元素(这似乎会引起一堆混乱(......
htmlwidgets::onRender('function(el) { el.querySelector("svg").removeAttribute("viewBox") }')
也不是说上述语法是可能的，因为htmlwidget是dplyr链中前一个命令的输出，但通常需要将htmlwidgets对象指定为第一个参数，例如......
sn <- sankeyNetwork(Links = links, Nodes = nodes, Source = "source",
Target = "target", Value = "value", NodeID = "name",
NodeGroup = "group", fontSize = 12, sinksRight = FALSE)
htmlwidgets::onRender(sn, 'function(el) { el.querySelector("svg").removeAttribute("viewBox") }')