Quantcast
Channel: Active questions tagged r - Stack Overflow
Viewing all articles
Browse latest Browse all 201894

sankeyNetwork through renderUI disappears when applying JScode to remove viewbox with htmlwidgets::onRender()

$
0
0

I have a Shiny app that creates a sankeyNetwork from the networkD3 package which accepts inputs to update the data used for the network and also resizes itself based on the number of nodes present. I posted a question last week and got the help I needed to get the reactive height argument applied.

I had previously found this question to resolve an issue where the output was tiny when viewed only from Firefox. I've read around on their issue pages and this still seems to be open.

My problem I'm seeking help for is that when I pair these two solutions, the app doesn't work as expected. In my actual app, when I update one of the inputs the height updates but the data used to create the diagram is the same. After updating the input a second time, the diagram disappears and remains gone until the app is terminated.

I have recreated a toy example here. This one behaves slightly different in that upon receiving updated inputs the data and size are both updated (in my actual one only the size is updated) but the disappearing act is indeed present. I couldn't recreate the data not updating but I'm hopeful that a fix for that will fix the other issue.

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)

Removing the htmlwidgets::onRender() call from the linked question allows the app to perform as expected, with the data and size updating based on the inputs. Leave it in and both will update but after switching a second time the diagram disappears.


Viewing all articles
Browse latest Browse all 201894

Trending Articles