根据动态列数和名称对数据框进行子集化

Question

我有下面的闪亮应用程序，用户可以在其中从数据框中选择一个或多个列名。

name<-c("John","Jack","Bill")
value1<-c(2,4,6)
add<-c("SDF","GHK","FGH")
value2<-c(3,4,5)
dt<-data.frame(name,value1,add,value2)

那么对于他所做的每一个选择，相对的pickerInput() 可能会显示在下面。然后根据选择的列或列及其值，我想对初始数据框进行子集化并将其显示在表格中。但是对于我将在原始应用程序中使用的每个不同的数据框，列的名称可能会有所不同，因此我不知道如何对其进行子集化。

library(DT)
# ui object
ui <- fluidPage(
    titlePanel(p("Spatial app", style = "color:#3474A7")),
    sidebarLayout(
        sidebarPanel(
            pickerInput(
                inputId = "p1",
                label = "Select Column headers",
                choices = colnames( dt),
                multiple = TRUE,
                options = list(`actions-box` = TRUE)
            ),
            #Add the output for new pickers
            uiOutput("pickers")
        ),
        
        mainPanel(
            DTOutput("table")
        )
    )
)

# server()
server <- function(input, output) {
    
    observeEvent(input$p1, {
        #Create the new pickers 
        output$pickers<-renderUI({
            div(lapply(input$p1, function(x){
                if (is.numeric(dt[[x]])) {
                    sliderInput(inputId=x, label=x, min=min(dt[x]), max=max(dt[[x]]), value=c(min(dt[[x]]),max(dt[[x]])))
                }
                else if (is.factor(dt[[x]])) {
                    selectInput(
                        inputId = x#The colname of selected column
                        ,
                        label = x #The colname of selected column
                        ,
                        choices = dt[,x]#all rows of selected column
                        ,
                        multiple = TRUE
                        
                    )
                }
                
            }))
        })
    })
    output$table<-renderDT({
        req(input$p1, sapply(input$p1, function(x) input[[x]]))
        dt_part <- dt
        for (colname in input$p1) {
            dt_part <- subset(dt_part, dt_part[[colname]] %in% input[[colname]])
        }
        dt_part
    })
}

# shinyApp()
shinyApp(ui = ui, server = server)

Answer 1

如果您将output$table 更改为以下内容，则可以：

output$table<-renderDT({
  req(input$p1, sapply(input$p1, function(x) input[[x]]))
  dt_part <- dt
  for (colname in input$p1) {
      if (is.factor(dt_part[[colname]])) {
        dt_part <- subset(dt_part, dt_part[[colname]] %in% input[[colname]])
      } else {
        dt_part <- subset(dt_part, (dt_part[[colname]] >= input[[colname]][[1]]) & dt_part[[colname]] <= input[[colname]][[2]])
      }
  }
  dt_part
})

第一行确保必填字段可用。
其余行根据input$p1 中的列和input[[input$p1]] 中的值重复过滤dt。