Create shiny app with sankey diagram that reacts to selectinput

问题

I'm trying to create a dashboard with a Sankey diagram and a selectInput that lets the end user choose filter the source column. I'm having trouble trying to figure out how to use the reactive expressions to filter the data. It's sort of complex because it's not just one step of reading the data in as it has to be preprocessed. I've tried putting the reactive filter at the end but it isn't working, as you'll see below. I tried also making each step reactive but that was a mess that certainly didn't work.

It's not working at the moment in the sense that 1) the dashboard loads but there's no diagram (should be the default/first value of schname) and 2) when I select the other schname it gives an "object of type closure is not subsettable" error. I think this means that I'm doing something wrong with the how I'm treating the reactive expression but I have yet to figure it out from all my searches.

Reprex:

library(shiny)
ui <- fluidPage(
  selectInput(inputId = "school",
              label   = "School",
              choices =  c("alpha", "echo")),

  sankeyNetworkOutput("diagram")
)

server <- function(input, output) {

  dat <- data.frame(schname = c("alpha", "alpha", "alpha", "echo"),
                    next_schname = c("bravo", "charlie", "delta", "foxtrot"),
                    count = c(1, 5, 3, 4))

  links <- data.frame(source = dat$schname,
                      target = dat$next_schname,
                      value  = dat$count)
  nodes <- data.frame(name = c(as.character(links$source),
                               as.character(links$target)) %>%
                        unique)

  links$IDsource <- match(links$source, nodes$name) - 1
  links$IDtarget <- match(links$target, nodes$name) - 1

  links <-reactive({
    links %>%
      filter(source == input$school)
  })


  output$diagram <- renderSankeyNetwork({
    sankeyNetwork(
      Links = links,
      Nodes = nodes,
      Source = "IDsource",
      Target = "IDtarget",
      Value = "value",
      NodeID = "name",
      sinksRight = FALSE
    )
  })
}

shinyApp(ui = ui, server = server)

回答1:

I think separating object names for links between the reactive and not reactive data frame is important. Second, for the render function, you want to call reactive objects like a function: links(). Third, make sure all dependencies are loaded for the app.

For example:

library(shiny)
library(networkD3)
library(dplyr)
ui <- fluidPage(
  selectInput(inputId = "school",
              label   = "School",
              choices =  c("alpha", "echo")),

  sankeyNetworkOutput("diagram")
)

server <- function(input, output) {

  dat <- data.frame(schname = c("alpha", "alpha", "alpha", "echo"),
                    next_schname = c("bravo", "charlie", "delta", "foxtrot"),
                    count = c(1, 5, 3, 4))

  links <- data.frame(source = dat$schname,
                      target = dat$next_schname,
                      value  = dat$count)
  nodes <- data.frame(name = c(as.character(links$source),
                               as.character(links$target)) %>%
                        unique)

  links$IDsource <- match(links$source, nodes$name) - 1
  links$IDtarget <- match(links$target, nodes$name) - 1

  links2 <-reactive({
    links %>%
      filter(source == input$school)
  })


  output$diagram <- renderSankeyNetwork({
    sankeyNetwork(
      Links = links2(),
      Nodes = nodes,
      Source = "IDsource",
      Target = "IDtarget",
      Value = "value",
      NodeID = "name",
      sinksRight = FALSE
    )
  })
}

shinyApp(ui = ui, server = server)

来源：https://stackoverflow.com/questions/57332088/create-shiny-app-with-sankey-diagram-that-reacts-to-selectinput

标签

Shiny

reactive

sankey-diagram