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

CJ Yetman
  • 8,373
  • 2
  • 24
  • 56
Andrea
  • 110
  • 6

1 Answers1

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") }')
CJ Yetman
  • 8,373
  • 2
  • 24
  • 56
  • 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 03 '18 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 03 '18 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 03 '18 at 14:04
  • Am trying @CJ Yetman solution within blogdown but it doesn't work in my case :( – Display name Mar 04 '19 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 '21 at 12:33