Question

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

我的真实数据有〜110列，这些列是numeric，character，factor，integer

我希望在侧边栏面板中有一个预先选择的过滤器，但还希望有一个+按钮，以允许用户基于列创建自定义过滤器。我不知道是否可以通过闪亮的方式完成此操作，我已经阅读了insertUI和removeUI的内容，但不知道是否可以将其应用于这种情况。用户创建的过滤器也应连续应用，即，如果用户创建了三个过滤器，则应先应用filter1，然后应用filter2，然后再应用filter3。

我有一个小示例应用程序，其中有一个基于Person且使用textAreaInput的初始过滤器（我的最终用户希望在框中粘贴一些名称以过滤表格），但我会喜欢添加一些其他过滤器，例如sliderInput的{{1}}或votes的dropdownMenu。

letters

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)

（我不确定应用过滤器的顺序会有所不同，如果我弄错了，也许可以对此进行阐述）。

Answer 2

您始终可以使用

随时更新您的过滤器

updateSelectInput和其他

https://shiny.rstudio.com/reference/shiny/0.13.2/updateSelectInput.html

最好！

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

2 个答案: