根据选择的输入中的多个值过滤表格并呈现光泽

Question

我正在尝试根据来自选择输入的多个值来过滤并呈现r闪亮的表格。这个想法是用户可以从选项1.Select config中选择多个值，并从2.Select var中选择一个值。基于此值，应从表testdata中过滤该数据并将其呈现在主面板中。什么下拉列表中的值不过是config和var列中唯一的字符串。下面是带有数据的代码。因此，用户可以从第一个下拉菜单中选择多个值，从第二个下拉菜单中选择一个值，然后单击“选择”按钮应显示该表。

library(shiny)
testdata <- tibble::tribble(
  ~config,       ~construct, ~var,
  "alpha,beta", "This is line 1",   12,
  "beta,gamma,alpha", "This is line 2",   15,
  "delta,alpha,tetra", "This is line 3",   21,
  "quad,core ,delta", "This is line 4",   12,
  "alpha,gamma", "This is line 5",   12,
  "beta,core", "This is line 5",   11,
  "delta,quad,tetra", "This is line 5",   21,
  "quad,tetra", "This is line 5",   12
)
config <- unique(unlist(strsplit(as.character(testdata$config), ",")))
var <- unique(unlist(strsplit(as.character(testdata$var), ",")))

ui <- fluidPage(
  title = 'Selectize examples',
  sidebarLayout(
    sidebarPanel(

      selectizeInput(
        'e2', '1.Select Config', choices = config, multiple = TRUE
      ),
      selectizeInput(
        'e3', '2. Select Var', choices = var, multiple = TRUE
      ),
      br(), 

      actionButton('select', 'Select')
    ),
    mainPanel(
      width = 10,
      DT::dataTableOutput(outputId = "mtable")

    )
  )
)

server <- function(input, output) {

  filtered_year <- reactive({
    filter(testdata, (config %in% input$e2) &
             (var %in% input$e3)
) 
  })

  fully_filtered <- eventReactive(input$select, {
    filtered_year()
  })

  output$mtable <- DT::renderDataTable({
    DT::datatable(data = fully_filtered(), options = list(pageLength = 10),
                  rownames = FALSE, class = 'display', escape = FALSE)

  })
  output$ex_out <- renderPrint({
    a <- str(sapply('e2', function(id) {
      input[[id]]
    }, simplify = FALSE))
    a
    print(a)
  })

}
shinyApp(ui = ui, server = server)

更新的代码：已添加以显示不显示过滤值的表。

Answer 1

这是您需要的吗？另外，如果仅希望用户能够从第二个下拉列表中选择一个值，则应使用multiple = FALSE。

library(shiny)
testdata <- tibble::tribble(
  ~config,       ~construct, ~var,
  "alpha,beta", "This is line 1",   12,
  "beta,gamma,alpha", "This is line 2",   15,
  "delta,alpha,tetra", "This is line 3",   21,
  "quad,core ,delta", "This is line 4",   12,
  "alpha,gamma", "This is line 5",   12,
  "beta,core", "This is line 5",   11,
  "delta,quad,tetra", "This is line 5",   21,
  "quad,tetra", "This is line 5",   12
)
config <- unique(unlist(strsplit(as.character(testdata$config), ",")))
var <- unique(unlist(strsplit(as.character(testdata$var), ",")))

ui <- fluidPage(
  title = 'Selectize examples',
  sidebarLayout(
    sidebarPanel(

      selectizeInput(
        'e2', '1.Select Config', choices = config, multiple = TRUE
      ),
      selectizeInput(
        'e3', '2. Select Var', choices = var, multiple = TRUE
      ),
      br(), 

      actionButton('select', 'Select')
    ),
    mainPanel(
      width = 10,
      DT::dataTableOutput(outputId = "mtable")

    )
  )
)

server <- function(input, output) {

  observeEvent(input$select, {
    print(input$e2)
    print(input$e3)
    fully_filtered <- testdata[grepl(paste(input$e2, collapse = "|"), testdata$config) &
                                 testdata$var %in% input$e3,]

    output$mtable <- DT::renderDataTable({
      DT::datatable(data = fully_filtered, options = list(pageLength = 10),
                    rownames = FALSE, class = 'display', escape = FALSE)

    })
  })

  output$ex_out <- renderPrint({
    a <- str(sapply('e2', function(id) {
      input[[id]]
    }, simplify = FALSE))
    a
    print(a)
  })

}
shinyApp(ui = ui, server = server)