Firefox 中 sankeyNetwork (NetworkD3) 的小圖輸出

Question

由於每個對象，我用的時候獲得在Firefox中非常小的情節sankeyNetwork()從networkd3在閃亮，但無法在Chrome或RStudio。

我沒有在腳本中包含任何 CSS 或 JS - 下面的代碼為我生成了這個結果。

有沒有我遺漏的 CSS 屬性？

我正在使用 R 3.4.1、閃亮的 1.1.0、networkD3 0.4 和 Firefox 52.9.0。

火狐：

鉻合金：

library(shiny)
library(magrittr)
library(shinydashboard)
library(networkD3)

labels = as.character(1:9)
ui <- tagList(
  dashboardPage(
    dashboardHeader(
      title = "appName"
    ),
    ##### dasboardSidebar #####
    dashboardSidebar(
      sidebarMenu(
        id = "sidebar",
        menuItem("plots",
                 tabName = "sPlots")
      )
    ),
    ##### dashboardBody #####
    dashboardBody(
      tabItems(
        ##### tab #####
        tabItem(
          tabName = "sPlots",
          tabsetPanel(
            tabPanel(
              "Sankey plot",
              fluidRow(
                box(title = "title",
                    solidHeader = TRUE, collapsible = TRUE, status = "primary",
                    sankeyNetworkOutput("sankeyHSM1")
                )
              )
            )
          )
        )
      )
    )
  )
)

server <- function(input, output, session) {

  HSM = matrix(rep(c(10000, 700, 10000-700, 200, 500, 50, 20, 10, 2,40,10,10,10,10),4),ncol = 4)
  sankeyHSMNetworkFun = function(x,ndx) {
    nodes = data.frame("name" = factor(labels, levels = labels),
                       "group" = as.character(c(1,2,2,3,3,4,4,4,4)))
    links = as.data.frame(matrix(byrow=T,ncol=3,c(
      0, 1, NA,
      0, 2, NA,
      1, 3, NA,
      1, 4, NA,
      3, 5, NA,
      3, 6, NA,
      3, 7, NA,
      3, 8, NA
    )))
    links[,3] = HSM[2:(nrow(links)+1),] %>% {rowSums(.[,(ndx-1)*2+c(1,2)])}
    names(links) = c("source","target","value")
    sankeyNetwork(Links = links, Nodes = nodes, Source = "source", Target = "target", Value = "value", NodeID = "name",NodeGroup = "group",
                  fontSize=12,sinksRight = FALSE)
  }
  output$sankeyHSM1 = renderSankeyNetwork({
    sankeyHSMNetworkFun(values$HSM,1)
  })
}

# Run the application
shinyApp(ui = ui, server = server)

- - - - - - - - - 編輯 - - - - - - - - - -

感謝@CJYetman 指出onRender()作為一個可能的解決方案 - 但是當有兩個並排生成的圖時失敗，如下面的 MRE（注意除了第二個桑基圖，我還添加了 javascript 代碼來重新繪制當窗口大小更改時的數字，因為繪圖似乎不會自動執行）。

library(shiny)
library(magrittr)
library(shinydashboard)
library(networkD3)
library(htmlwidgets)

labels = as.character(1:9)
ui <- tagList(
  tags$head(
    tags$script('
var dimension = [0, 0];
$(document).on("shiny:connected", function(e) {
    dimension[0] = window.innerWidth;
    dimension[1] = window.innerHeight;
    Shiny.onInputChange("dimension", dimension);
});
$(window).resize(function(e) {
    dimension[0] = window.innerWidth;
    dimension[1] = window.innerHeight;
    Shiny.onInputChange("dimension", dimension);
});
                            ')
  ),
  dashboardPage(
    dashboardHeader(
      title = "appName"
    ),
    ##### dasboardSidebar #####
    dashboardSidebar(
      sidebarMenu(
        id = "sidebar",
        menuItem("plots",
                 tabName = "sPlots")
      )
    ),
    ##### dashboardBody #####
    dashboardBody(
      tabItems(
        ##### tab #####
        tabItem(
          tabName = "sPlots",
          tabsetPanel(
            tabPanel(
              "Sankey plot",
              fluidRow(
                box(title = "title",
                    solidHeader = TRUE, collapsible = TRUE, status = "primary",
                    sankeyNetworkOutput("sankeyHSM1")
                ),
                box(title = "plot2",
                    solidHeader = TRUE, collapsible = TRUE, status = "primary",
                    sankeyNetworkOutput("sankeyHSM2"))
              )
            )
          )
        )
      )
    )
  )
)

server <- function(input, output, session) {

  HSM = matrix(rep(c(10000, 700, 10000-700, 200, 500, 50, 20, 10, 2,40,10,10,10,10),4),ncol = 4)
  sankeyHSMNetworkFun = function(x,ndx) {
    nodes = data.frame("name" = factor(labels, levels = labels),
                       "group" = as.character(c(1,2,2,3,3,4,4,4,4)))
    links = as.data.frame(matrix(byrow=T,ncol=3,c(
      0, 1, NA,
      0, 2, NA,
      1, 3, NA,
      1, 4, NA,
      3, 5, NA,
      3, 6, NA,
      3, 7, NA,
      3, 8, NA
    )))
    links[,3] = HSM[2:(nrow(links)+1),] %>% {rowSums(.[,(ndx-1)*2+c(1,2)])}
    names(links) = c("source","target","value")
    sankeyNetwork(Links = links, Nodes = nodes, Source = "source", Target = "target", Value = "value", NodeID = "name",NodeGroup = "group",
                  fontSize=12,sinksRight = FALSE)
  }
  output$sankeyHSM1 = renderSankeyNetwork({
    req(input$dimension)
    sankeyHSMNetworkFun(values$HSM,1) %>%
      onRender('document.getElementsByTagName("svg")[0].setAttribute("viewBox", "")')
  })
  output$sankeyHSM2 = renderSankeyNetwork({
    req(input$dimension)
    sankeyHSMNetworkFun(values$HSM,2) %>%
      onRender('document.getElementsByTagName("svg")[0].setAttribute("viewBox", "")')
  })
}

# Run the application
shinyApp(ui = ui, server = server)

------------------ EDIT2 --------------------

上面的第二個問題解決了 - 或者通過使用document.getElementsByTagName("svg")[1].setAttribute("viewBox","")根據下面@CJYetman 的評論引用頁面上的第二個 svg 項目，或者通過進入對象本身使用document.getElementById("sankeyHSM2").getElementsByTagName("svg")[0].setAttribute("viewBox","")選擇他們的第一個 svg 元素。

Answer 1

這似乎是 Firefox 對viewbox svg 屬性的反應與其他瀏覽器不同的結果。 在這里提交這個問題可能是值得的https://github.com/christophergandrud/networkD3/issues

在此期間，您可以解決此通過重新設置viewbox使用一些JavaScript和屬性htmlwidgets::onRender() 這是使用示例的最小化版本的示例。 （重置viewbox屬性可能有其他后果）

library(htmlwidgets)
library(networkD3)
library(magrittr)

nodes = data.frame("name" = factor(as.character(1:9)),
                   "group" = as.character(c(1,2,2,3,3,4,4,4,4)))

links = as.data.frame(matrix(byrow = T, ncol = 3, c(
  0, 1, 1400,
  0, 2, 18600,
  1, 3, 400,
  1, 4, 1000,
  3, 5, 100,
  3, 6, 40,
  3, 7, 20,
  3, 8, 4
)))
names(links) = c("source","target","value")

sn <- sankeyNetwork(Links = links, Nodes = nodes, Source = "source", 
                    Target = "target", Value = "value", NodeID = "name", 
                    NodeGroup = "group", fontSize = 12, sinksRight = FALSE)

htmlwidgets::onRender(sn, 'document.getElementsByTagName("svg")[0].setAttribute("viewBox", "")')

---

更新 (2019.10.26)

這可能是刪除 viewBox 的更安全的實現......

htmlwidgets::onRender(sn, 'function(el) { el.getElementsByTagName("svg")[0].removeAttribute("viewBox") }')

---

更新 2020.04.02

我目前首選的方法是使用htmlwidgets::onRender專門針對傳遞的 htmlwidget 包含的 SVG，就像這樣...

onRender(sn, 'function(el) { el.querySelector("svg").removeAttribute("viewBox") }')

然后可以根據需要htmlwidgets對頁面上的盡可能多的htmlwidgets完成，例如......

onRender(sn, 'function(el) { el.querySelector("svg").removeAttribute("viewBox") }')

onRender(sn2, 'function(el) { el.querySelector("svg").removeAttribute("viewBox") }')