Question

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

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

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

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

问题

我似乎无法正确地制定过滤器语句。输入$ selVar的动态referall不起作用： 过滤（输入$ selVar == input $ selData），虽然明确提到过滤器语句中的selVar1确实有效，但会失去动态行为：过滤器（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服务器和ui设置。

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)

-output

filter（）一个带有来自输入控件

1 个答案: