使用对 selectinput 做出反应的 sankey 图创建闪亮的应用程序

Question

我正在尝试使用桑基图和 selectInput 创建一个仪表板，让最终用户选择过滤源列。我在试图弄清楚如何使用反应式表达式来过滤数据时遇到了麻烦。这有点复杂，因为它不仅仅是读取数据的一个步骤，因为它必须进行预处理。我尝试将反应式过滤器放在最后，但它不起作用，如下所示。我也尝试过让每个步骤都具有反应性，但这肯定是一团糟。

目前它不起作用，因为 1）仪表板加载但没有图表（应该是 schname 的默认/第一个值）和 2）当我选择另一个 schname 时，它​​给出了“类型关闭的对象不是子集”错误。我认为这意味着我在处理反应性表达的方式上做错了，但我还没有从我的所有搜索中弄清楚。

代表：

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)

Answer 1

我认为将 links 的对象名称在反应式和非反应式数据帧之间分开很重要。其次，对于渲染函数，你想像函数一样调用反应对象：links()。第三，确保为应用程序加载了所有依赖项。

例如：

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)