使用对选择输入做出反应的桑基图创建闪亮的应用程序

Create shiny app with sankey diagram that reacts to selectinput

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

目前无法正常工作,因为 1) 仪表板加载但没有图表(应该是 schname 的 default/first 值)和 2) 当我 select 另一个 schname它给出了 "object of type closure is not subsettable" 错误。我认为这意味着我在处理反应式表达式的方式上做错了,但我还没有从我的所有搜索中弄清楚。

代表:

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)

我认为将 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)