8

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

1 Answer 1

10

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") }')
5
  • 1
    Thanks @CJYetman - this works very well when there is a single chart on the page but fails when there are two, any ideas? I am editing the question above with an MRE
    – Andrea
    Jul 3, 2018 at 13:32
  • 2
    Change the [0] to [1] in the line of JavaScript to select the second svg. Duplicate the entire JacaScript line and set the numbers appropriately to affect multiple svgs (use a ; between JavaScript commands)
    – CJ Yetman
    Jul 3, 2018 at 13:40
  • 1
    I have just managed to solve this by using document.getElementById().getElementsByTagName("svg")[0].setAttribute() which worked like a charm. Thank you very much!
    – Andrea
    Jul 3, 2018 at 14:04
  • Am trying @CJ Yetman solution within blogdown but it doesn't work in my case :( Mar 4, 2019 at 18:52
  • Thanks @CJYetman for pointing out this solution. In rmarkdown this also works nicely as final line of a custom function to create multiple sankey plots from a list of dfs using lapply. For example list_sn <- lapply (list_dfs, function(x) {'functional arguments defining sn ending with:' onRender(sn, 'function(el) { el.querySelector("svg").removeAttribute("viewBox") }')}) and subsequent output using list_sn[[i]].
    – GRowInG
    Feb 11, 2021 at 12:33

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge that you have read and understand our privacy policy and code of conduct.

Not the answer you're looking for? Browse other questions tagged or ask your own question.