filter() 具有来自输入控件的动态输入的数据集

Question

我创建了一个简化的 Shiny 仪表板。仪表板中的数据基于包含 3 个变量“selVar1”、“selVar2”和“val”的数据集 foo。

侧边栏面板由两部分组成。用于选择 selVar1 或 selVar2 列的输入控件和显示 selVar1 或 selVar2 的唯一值（基于 selectInput 的 selVar 的条件值）的条件面板。

• 如果选择了 selVar == selVar1，则显示 foo$selVar1 列的唯一值
• 如果选择了 selVar == selVar2，则会显示 foo$selVar2 列的唯一值

输出是根据条件过滤器中选择的值过滤数据集 foo 后的单个值。

问题

我似乎无法正确地制定过滤器语句。 input$selVar 的动态引用不起作用： filter(input$selVar == input$selData)，虽然在 filter 语句中明确提及 selVar1 确实有效，但会丢失动态行为：filter(selVar1 == input$selData)。我已经尝试过使用 filter_ 或 filter 的多种组合，但我似乎无法正确使用它。如何根据输入控制按钮的结果获得数据集的动态过滤？似乎我真的不明白非标准与标准评估表达式发生了什么以使其工作。

  #generate textOutput
  outp <- reactive({
    tmp <- foo %>%
      select_(input$selVar, 'val') %>%
      filter(input$selVar == input$selData) %>%
      summarise(val = sum(val)) %>%
      select(val) %>%
      as.character()
  })

示例

#Input dataset foo:
  selVar1 selVar2 val
       1       b  10
       2       d  30
       3       d  50
       4       c  70
       5       b  90

#input selection selVar == selVar1
#input selection conditional panel selVar 1 == 3
#output: val = 50

完整的 Shiny 服务器和用户界面设置见下文。

library(shiny)
library(shinydashboard)
library(dplyr)

#dataset
foo <- structure(list(selVar1 = 1:5, 
                          selvar2 = c("b", "d", "d", "c","b"), 
                          val = c(10, 30, 50, 70, 90)), 
                     .Names = c("selVar1", "selVar2","val"), row.names = c(NA, -5L), class = "data.frame")

#Selection lists for conditional selection input:
    lstSelVar <- c('selVar1', 'selVar2')
    lstVar1 <- unique(foo$selVar1)[order(unique(foo$selVar1))]
    lstVar2 <- unique(foo$selVar2)[order(unique(foo$selVar2))]

#UI setup: 

'== sidebar
========================'

sidebar <- dashboardSidebar(
  sidebarMenu(
    selectInput("selVar", h5("Select variable:"), choices = as.list(lstSelVar), selected = 1),
    conditionalPanel(
      condition = "input.selVar == 'selVar1'",
      selectInput("selData", h5("Select value:"), choices = as.list(lstVar1), selected = 1)
    ),
    conditionalPanel(
      condition = "input.selVar == 'selVar2'",
      selectInput("selData", h5("Select value:"), choices = as.list(lstVar2), selected = 1)
    )
  )
)



'== body
========================'

body <- dashboardBody(
    fluidRow(
      column(
          dataTableOutput("tbl"), width = 3
      ),
      column(
        box(
          h4("Single output value:"),
          textOutput("outpVal")
        ), width = 3
      )      
    )
)

'== Define UI for application
========================'

ui <- dashboardPage(
  dashboardHeader(title = "Conditional Panels"),
  sidebar,
  body
)

'== Define server logic
========================'
server <- function(input, output) {
  output$tbl <-  renderDataTable(foo)  


  #generate textOutput
  outp <- reactive({
    tmp <- foo %>%
      select_(input$selVar, 'val') %>%
      filter(input$selVar == input$selData) %>%
      summarise(val = sum(val)) %>%
      select(val) %>%
      as.character()
  })

  output$outpVal <- renderText({
    outp()
  })
}

'== Run the application
========================'
shinyApp(ui = ui, server = server)

Answer 1

最好为selectInput 使用不同的名称。此外，我们可以使用select_at 和filter_at 来选择和过滤行。

sidebar <- dashboardSidebar(
  sidebarMenu(
    selectInput("selVar", h5("Select variable:"), choices = as.list(lstSelVar), selected = 1),
    conditionalPanel(
      condition = "input.selVar == 'selVar1'",
      selectInput("selData1", h5("Select value:"), choices = as.list(lstVar1), selected = 1)
    ),
    conditionalPanel(
      condition = "input.selVar == 'selVar2'",
      selectInput("selData2", h5("Select value:"), choices = as.list(lstVar2), selected = 1)
    )
  )
)






body <- dashboardBody(
  fluidRow(
    column(
      dataTableOutput("tbl"), width = 3
    ),
    column(
      box(
        h4("Single output value:"),
        textOutput("outpVal")
      ), width = 3
    )      
  )
)



ui <- dashboardPage(
  dashboardHeader(title = "Conditional Panels"),
  sidebar,
  body
)


server <- function(input, output) {
  output$tbl <-  renderDataTable(foo)  





  #generate textOutput

  outp <- reactive({
   sD <- if(input$selVar == 'selVar1') input$selData1 else input$selData2

    tmp <- foo %>%
      select_at(vars(input$selVar, 'val')) %>%
      filter_at(vars(input$selVar), all_vars(.== sD)) %>%
      summarise(val = sum(val)) %>%
      select(val) %>%
      as.character()
  })


  output$outpVal <- renderText({
    outp()
  })
}


shinyApp(ui = ui, server = server)

-输出