Shiny动态加载CSV文件并按指定列筛选数据的问题求助

问题描述 #

构建Shiny应用需实现以下功能：

• 加载指定目录下任意CSV文件
• 从加载的文件中选择显示列，再选择两列作为筛选属性，根据选中的属性值对数据进行子集化
  目前已实现文件加载、列选择功能，但筛选下拉选择器无法显示所选属性列的可选值，需修复该问题。

原代码 #

library(dplyr)
library(shinyWidgets)
library(shinythemes) # 补充原代码遗漏的包加载

fpath <- '/dbfs/May2022'

# Define UI
ui <- fluidPage(theme = shinytheme("spacelab"),
                navbarPage(
                  "MyQA Machine Learning Platform",
                  tabPanel(
                    "Select File",
                    sidebarPanel(
                      selectInput('selectfile','Select File',choice = list.files(fpath, pattern = ".csv")),
                      mainPanel("Main Panel",dataTableOutput("ftxtout"),style = "font-size:50%")
                    ),
                  ),
                  tabPanel("Subset Data",
                           sidebarPanel(                
                             dropdown(
                               label = "Please Select Columns to Display", 
                               icon = icon("sliders"),
                               status = "primary",
                               pickerInput(
                                 inputId = "columns",
                                 choices = NULL,
                                 multiple = TRUE
                               )
                             ),
                             selectInput("v_attribute1", "First Attribute to Filter Data", choices = NULL), 
                             selectInput("v_attribute2", "Second Attribute to Filter Data", choices = NULL),
                             selectInput("v_filter1", "First Filter", choices = NULL),
                             selectInput("v_filter2", "Second Filter", choices = NULL),
                             
                           ),
                           mainPanel(tags$br(),tags$br(),
                                     h4("Data Selection"),
                                     dataTableOutput("txtout"),style = "font-size:70%"
                           )
                           
                  ),
                  tabPanel("Create Label", "This panel is intentionally left blank")     
                  
                )
)


# Define server function  
server <- function(input, output, session) {     
  output$fileselected<-renderText({
    paste0('You have selected: ', input$selectfile)
  })
  
  info <- eventReactive(input$selectfile, {
    req(input$selectfile)
    fullpath <- file.path(fpath,input$selectfile)
    df <- read.csv(fullpath, header = TRUE,  sep = ",")
    vars <- names(df)
    updatePickerInput(session, "columns","Select Columns", choices = vars)
    updateSelectInput(session, "v_attribute1","First Attribute to Filter Data", choices = vars)
    updateSelectInput(session, "v_attribute2","Second Attribute to Filter Data", choices = vars)
    df
  })   
  
  # 监听第一筛选属性变化，更新对应筛选选项
  observeEvent(input$v_attribute1, {
    req(info())
    df <- info()
    if(!is.null(input$v_attribute1) && input$v_attribute1 != ""){
      choices <- unique(df[[input$v_attribute1]])
      updateSelectInput(session, "v_filter1", choices = choices)
    }
  })
  
  # 监听第二筛选属性变化，更新对应筛选选项
  observeEvent(input$v_attribute2, {
    req(info())
    df <- info()
    if(!is.null(input$v_attribute2) && input$v_attribute2 != ""){
      choices <- unique(df[[input$v_attribute2]])
      updateSelectInput(session, "v_filter2", choices = choices)
    }
  })
  
  output$ftxtout <- renderDataTable({
    req(input$selectfile)
    fullpath <- file.path(fpath,input$selectfile)
    df <- read.csv(fullpath, header = TRUE,  sep = ",")
    head(df)
  }, options =list(pageLength = 5))
  
  output$txtout <- renderDataTable({
    f <- info()
    # 处理列选择
    if(!is.null(input$columns) && length(input$columns) > 0){
      f <- subset(f, select = input$columns)
    }
    # 处理第一筛选条件
    if(!is.null(input$v_attribute1) && !is.null(input$v_filter1)){
      f <- filter(f, .data[[input$v_attribute1]] == input$v_filter1)
    }
    # 处理第二筛选条件
    if(!is.null(input$v_attribute2) && !is.null(input$v_filter2)){
      f <- filter(f, .data[[input$v_attribute2]] == input$v_filter2)
    }
    head(f)
  }, options =list(pageLength = 5))
  
}

# Create Shiny object
shinyApp(ui = ui, server = server)

问题修复要点 #

1. 动态列访问错误：原代码用df$var1无法解析字符串变量，改用df[[input$v_attribute1]]语法动态获取列值
2. 更新时机错误：将筛选下拉框的更新逻辑从文件加载事件中移出，改用observeEvent监听属性列选择事件，确保用户选择属性列后才更新筛选选项
3. 筛选逻辑错误：原代码直接比较字符串，改用.data[[input$v_attribute1]]动态引用数据列，实现正确的筛选逻辑
4. 补全依赖包：添加shinythemes包加载，避免主题调用报错

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