使用 htmlwidgets::onRender() 应用 JScode 删除视图框时，通过 renderUI 的 sankeyNetwork 消失答案

【问题标题】：sankeyNetwork through renderUI disappears when applying JScode to remove viewbox with htmlwidgets::onRender()使用 htmlwidgets::onRender() 应用 JScode 删除视图框时，通过 renderUI 的 sankeyNetwork 消失
【发布时间】：2019-10-16 17:01:39
【问题描述】：

我有一个 Shiny 应用程序，它从 networkD3 包创建一个 sankeyNetwork，它接受输入以更新用于网络的数据，并根据存在的节点数量调整自身大小。我上周发布了a question，并获得了应用反应高度参数所需的帮助。

我之前曾找到this question 来解决仅在 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() 调用允许应用按预期执行，并根据输入更新数据和大小。保留它，两者都会更新，但在第二次切换后图表消失。

【问题讨论】：

标签： r shiny sankey-diagram htmlwidgets networkd3

【解决方案1】：

尝试使用这个...

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

【讨论】：