r - 让用户在 Shinydashboard 应用程序中创建不同的按钮操作

Question

我想构建一个 Shiny 的应用程序，允许用户选择一些列来过滤 data.table 。

我的真实数据有 ~110 列，列是 numeric 、 character 、 factor 、 integer
我想在侧边栏面板中有一个预先选择的过滤器，但也有一个 + 按钮，允许用户根据列创建自定义过滤器。我不知道这是否可以通过 Shiny 完成，我已经阅读了 insertUI 和 removeUI 但我不知道这是否可以应用于这种情况。此外，应连续应用用户创建的过滤器，即，如果用户创建三个过滤器，则应应用 filter1，然后应用 filter2，然后应用 filter3。

我有这个小示例应用程序，其中有一个基于 Person 使用 textAreaInput 的初始过滤器(我的最终用户想在框中粘贴一些名称以过滤掉表格)，但我想添加一些其他过滤器，例如 sliderInput votes 或 letters 的 dropdownMenu 。

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

header <- dashboardHeader(title="Analysis and database")

sidebar <- dashboardSidebar(
  sidebarMenu(
   # Setting id makes input$tabs give the tabName of currently-selected tab
    id = "sidebarmenu",
    menuItem("Database", tabName="db"),
    menuItem("Search by Name", tabName = "Filt_table"),
      textAreaInput("name_", "Name")
 )
)

body <- dashboardBody(

 tabItems(
  tabItem("db","table content",
        fluidRow(DT::dataTableOutput('tabla'))),
  tabItem("Filt_table","Filtered table content",
        fluidRow(DT::dataTableOutput('tablafilt')))
 )
)

ui <- dashboardPage(header, sidebar, body)

### SERVER SIDE

server = function(input, output, session) {

my_data <- data.frame(Person=c("Anne", "Pete", "Rose", "Julian", "Tristan", "Hugh"), 
Votes=c(10,25,56,89.36,78,1500), 
Stuff=c("test|3457678", "exterm|4567sdf", "1001(hom);4.3.4|3456", "xdfrtg", "1234|trsef|456(het)", "hyggas|tertasga"),
 letters=replicate(6, paste(sample(LETTERS,6, replace=T), collapse="")))

output$tabla <- DT::renderDataTable({
  DT::datatable(my_data)
})

filtered <- reactive({
  if(is.null(input$name_))
    return()  
    glist <- isolate(input$name_)
    filter(my_data, Person %in% glist)
 })

output$tablafilt <- DT::renderDataTable({
  if(is.null(input$name_))
    return()  

   DT::datatable(filtered (), 
              filter = 'top', 
              extensions = 'Buttons',
              options = list(
                dom = 'Blftip',
                buttons = 
                  list('colvis', list(
                    extend = 'collection',
                    buttons = list(list(extend='csv',
                                        filename = 'results'),
                                   list(extend='excel',
                                        filename = 'results'),
                                   list(extend='pdf',
                                        filename= 'results')),
                    text = 'Download'
                  )),
                scrollX = TRUE,
                pageLength = 5,
                lengthMenu = list(c(5, 15, -1), list('5', '15', 'All'))
              ), rownames = FALSE
    )
  })



}
shinyApp(ui, server)

Answer 1

您可以首先为所有变量创建一个 selectInput() 以及添加和删除按钮:

  output$potentialFilter <- renderUI({
    tagList(
      selectInput("createFilter", "Create Filter", names(my_data)),
      actionButton("remove", "remove"),
      actionButton("add", "add")
    )
  })

然后您可以为所选变量创建输入。
注意:由于您不想在添加新 UI 时重置插入的 UI，您应该使用 insertUI() 而不是 renderUI() 。

  insertUI(selector = "#add", where = "afterEnd", 
           ui = selectizeInput(toBeIncluded, toBeIncluded, my_data[[toBeIncluded]], 
                               selected = my_data[[toBeIncluded]], multiple = TRUE)
  )

完整示例为:

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

  header <- dashboardHeader(title="Analysis and database")

  sidebar <- dashboardSidebar(
    sidebarMenu(
      # Setting id makes input$tabs give the tabName of currently-selected tab
      id = "sidebarmenu",
      menuItem("Database", tabName="db"),
      menuItem("Search by Name", tabName = "Filt_table"),
      uiOutput("potentialFilter"),
      uiOutput("rendFilter")
    )
  )

  body <- dashboardBody(

    tabItems(
      tabItem("db","table content",
              fluidRow(DT::dataTableOutput('tabla'))),
      tabItem("Filt_table","Filtered table content",
              fluidRow(DT::dataTableOutput('tablafilt')))
    )
  )

  ui <- dashboardPage(header, sidebar, body)

  ### SERVER SIDE

  server = function(input, output, session) {

    my_data <- data.frame(Person=c("Anne", "Pete", "Rose", "Julian", "Tristan", "Hugh"), 
                          Votes=c(10,25,56,89.36,78,1500), 
                          Stuff=c("test|3457678", "exterm|4567sdf", "1001(hom);4.3.4|3456", "xdfrtg", "1234|trsef|456(het)", "hyggas|tertasga"),
                          letters=replicate(6, paste(sample(LETTERS,6, replace=T), collapse="")),
                          stringsAsFactors = FALSE)

    global <- reactiveValues(filter = c(), filteredData = my_data, tagList = tagList())

    output$potentialFilter <- renderUI({
      tagList(
        selectInput("createFilter", "Create Filter", names(my_data)),
        actionButton("remove", "remove"),
        actionButton("add", "add")
      )
    })


    observeEvent(input$add, {
      global$filter <- c(global$filter, input$createFilter)
      toBeIncluded <- input$createFilter
      data <- my_data[[toBeIncluded]]
      if(typeof(data) == "double"){
        ui <- numericInput(toBeIncluded, toBeIncluded, ceiling(min(data)), min = min(data), max = max(data))
      }else if(typeof(data) == "character"){
        ui <- textAreaInput(toBeIncluded, toBeIncluded, data[1], width = "200px")
      }
      insertUI(selector = "#add", where = "afterEnd", ui = ui)
    })

    observeEvent(input$remove, {  
      global$filter <- setdiff(global$filter, input$createFilter)
      removeUI(selector = paste0("div:has(> #", input$createFilter, ")"))
    })

    output$tabla <- DT::renderDataTable({
      DT::datatable(filtered())
    })

    filtered <- reactive({
      if(length(global$filter)){
        for(filterName in global$filter){
          if(is.character(input[[filterName]])){
            names <- unlist(strsplit(input[[filterName]], ";"))
            my_data <- my_data[my_data[[filterName]] %in% names, ]           
          }else if(is.numeric(input[[filterName]])){
            my_data <- my_data[my_data[[filterName]] >= input[[filterName]], ] 
          }
        }
      }
      return(my_data)
    })

    output$tablafilt <- DT::renderDataTable({
      DT::datatable(filtered(), 
                    filter = 'top', 
                    extensions = 'Buttons',
                    options = list(
                      dom = 'Blftip',
                      buttons = 
                        list('colvis', list(
                          extend = 'collection',
                          buttons = list(list(extend='csv',
                                              filename = 'results'),
                                         list(extend='excel',
                                              filename = 'results'),
                                         list(extend='pdf',
                                              filename= 'results')),
                          text = 'Download'
                        )),
                      scrollX = TRUE,
                      pageLength = 5,
                      lengthMenu = list(c(5, 15, -1), list('5', '15', 'All'))
                    ), rownames = FALSE
      )
    })



  }
  shinyApp(ui, server)

(我不确定它对您应用过滤器的顺序有影响，如果我弄错了，也许您可​​以对此进行详细说明)。