Welcome to OStack Knowledge Sharing Community for programmer and developer-Open, Learning and Share
Welcome To Ask or Share your Answers For Others

Categories

0 votes
411 views
in Technique[技术] by (71.8m points)

r - Tiny plot output from sankeyNetwork (NetworkD3) in Firefox

As per object, I get a very small plot in Firefox when using sankeyNetwork() from in but not in Chrome or RStudio.

I have not included any CSS or JS in the script - the code below produces this result for me.

Is there any CSS property I have missed?

I am using R 3.4.1, shiny 1.1.0, networkD3 0.4 and Firefox 52.9.0.

Firefox: Firefox

Chrome: Chrome

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)

------------------ EDIT --------------------

Thanks to @CJYetman for indicating onRender() as a possible solution - however this fails when there are two plots generated side by side as in the MRE below (note in addition to the second sankey plot I have also added javascript code to re-draw the figures when the window size changes as the plot does not appear to do it automatically).

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 --------------------

Second problem above solved - either by referring to the second svg item on the page as per @CJYetman's comment below using document.getElementsByTagName("svg")[1].setAttribute("viewBox",""), or by going into the objects themselves selecting their first svg element with document.getElementById("sankeyHSM2").getElementsByTagName("svg")[0].setAttribute("viewBox","").

See Question&Answers more detail:os

与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…
Welcome To Ask or Share your Answers For Others

1 Answer

0 votes
by (71.8m points)

This seems to be the result of Firefox reacting to the viewbox svg property differently than other browsers. It might be worthwhile to submit this as an issue here https://github.com/christophergandrud/networkD3/issues

In the meantime, you could work around this by resetting the viewbox attribute using some JavaScript and htmlwidgets::onRender(). Here's an example using a minimized version of your example. (Resetting the viewbox attribute may have other consequences)

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

UPDATE (2019.10.26)

This is probably a safer implementation of removing the viewBox...

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

UPDATE 2020.04.02

My currently preferred method to do this is to use htmlwidgets::onRender to target specifically the SVG contained by the passed htmlwidget, like this...

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

That can then be done specifically to as many htmlwidgets on your page as necessary, for instance...

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

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

与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…
Welcome to OStack Knowledge Sharing Community for programmer and developer-Open, Learning and Share
Click Here to Ask a Question

...