在Shiny应用中新增按指定列筛选数据集的功能

以下是修改后的完整代码，实现了你需要的按列筛选功能，同时保留原有的全局搜索和重置功能：

# 加载所需包
library(shiny)
library(shinydashboard)
library(DT)
library(shinyWidgets)
library(dplyr)

# 加载数据集
data_test_1_ <- structure(
  list(
    Dimension = rep("environmental", 10),
    Component = c("air quality", "air quality", "air quality", 
                  "water quality", rep("environmental hazards", 5), 
                  "physical safety"),
    Indicator = c("outdoor", "outdoor", "indoor", NA, 
                  "Hazardous waste", "Heavy metals", "Pesticides", 
                  "Climate extremes", "Noise", "Traffic")
  ),
  row.names = c(NA, 10L),
  class = c("tbl_df", "tbl", "data.frame")
)

# UI部分
ui <- dashboardPage(
  dashboardHeader(title = "Dataset Inventory"),
  dashboardSidebar(
    # 全局搜索
    textInput("tt", "搜索整个数据集", ""),
    actionButton("ser", "开始搜索"),
    tags$hr(),
    
    # 按列搜索
    pickerInput(
      inputId = "p3",
      label = "选择要搜索的列",
      choices = colnames(data_test_1_),
      selected = colnames(data_test_1_)[1],
      multiple = FALSE,
      options = list(`actions-box` = TRUE)
    ),
    textInput("tt2", "搜索指定列", ""),
    actionButton("ser2", "开始搜索"),
    tags$hr(),
    
    # 重置按钮
    actionButton("res", "重置")
  ),
  dashboardBody(
    div(DT::dataTableOutput("table"), style = "font-size: 80%; width: 100%")
  )
)

# Server部分
server <- function(input, output, session) {
  # 用响应式值存储当前显示的数据集
  current_data <- reactiveValues(df = data_test_1_)
  
  # 渲染表格
  output$table <- renderDataTable({
    datatable(current_data$df, escape = FALSE)
  })
  
  # 全局搜索逻辑
  observeEvent(input$ser, {
    search_term <- isolate(input$tt)
    if (search_term != "") {
      current_data$df <- data_test_1_[apply(data_test_1_, 1, function(x) any(grepl(search_term, x, ignore.case = TRUE))), ]
    } else {
      current_data$df <- data_test_1_
    }
  })
  
  # 按列搜索逻辑
  observeEvent(input$ser2, {
    search_term <- isolate(input$tt2)
    target_col <- isolate(input$p3)
    if (search_term != "") {
      current_data$df <- data_test_1_ %>%
        filter(grepl(search_term, .data[[target_col]], ignore.case = TRUE))
    } else {
      current_data$df <- data_test_1_
    }
  })
  
  # 重置逻辑
  observeEvent(input$res, {
    current_data$df <- data_test_1_
    updateTextInput(session, "tt", value = "")
    updateTextInput(session, "tt2", value = "")
  })
}

shinyApp(ui, server)

修改说明 #

• 用reactiveValues统一管理当前显示的数据集，避免重复创建renderDataTable，提升性能
• 全局搜索和按列搜索都基于原始数据集进行筛选，确保每次搜索都是从完整数据开始
• 按列搜索使用dplyr::filter结合.data[[target_col]]动态引用选中列，实现精准匹配
• 重置按钮同时清空两个搜索框的内容，并恢复原始数据集
• 移除了无用的uiOutput("column")，因为已有pickerInput实现列选择功能
• 所有搜索添加了ignore.case = TRUE，实现大小写不敏感的模糊匹配（可根据需求移除）

内容的提问来源于stack exchange，提问作者firmo23