如何在 R Shiny 中构建动态过滤器？

Question

我正在构建一个具有上传功能和类别变量过滤功能的应用程序。这样，用户可以通过指定列和值来进行一些数据操作。但是，过滤功能不起作用。代码简化如下：

#ui.R
library(shiny)

fluidPage(
  titlePanel("Test Dynamic Column Selection"),
  sidebarLayout(
    sidebarPanel(
      fileInput('file1', 'Choose CSV File',
            accept=c('text/csv', 
                     'text/comma-separated-values,text/plain', 
                     '.csv')),
      hr(),
      checkboxInput('header', 'Header', TRUE),
      radioButtons('sep', 'Separator',
               c(Comma=',',
                 Semicolon=';',
                 Tab='\t'),
               ','),
      hr(),
      uiOutput("choose_columns"),
      hr(),
      uiOutput("choose_column"),
      textInput('column_value', label = 'Value'),
      actionButton('filter', label = 'Filter')
    ),
    mainPanel(
      tableOutput('contents')
    )
  )
)

#server.R
library(shiny)

function(input, output) {

  uploaded_data <- reactive({
    inFile <- input$file1
    read.table(inFile$datapath, header=input$header, sep=input$sep, quote=input$quote)
  })

  react_vals <- reactiveValues(data = NULL)

  output$choose_columns <- renderUI({
    if(is.null(input$file1))
      return()

    colnames <- names(react_vals$data)

    checkboxGroupInput("choose_columns", "Choose columns", 
                   choices  = colnames,
                   selected = colnames)
  })

  output$choose_column <- renderUI({
    if(is.null(input$file1))
      return()
    is_factor <- sapply(react_vals$data, is.factor)
    colnames <- names(react_vals$data[, is_factor])
    selectInput("choose_column", "Choose column", choices = colnames)
  })

  observeEvent(input$file1, react_vals$data <- uploaded_data())
  observeEvent(input$choose_columns, react_vals$data <- react_vals$data[, input$choose_columns])

  # This line of code does not work :(
  observeEvent(input$filter, react_vals$data <- subset(react_vals$data, input$choose_column != input$column_value))

  output$contents <- renderTable(react_vals$data)
}

Answer 1

我认为您的应用存在多个问题，我尝试逐步解释：

1. input$choose_columns 依赖于 react_vals$data 反应值，因此当取消选中复选框时，Shiny 会为 react_vals$data 分配一个新值，并减少一列，然后重新渲染 input$choose_columns UI，以便少一个复选框可用的。 （与input$choose_column selectInput 相同）

您的代码：

colnames <- names(react_vals$data)

替换代码：

colnames <- names(uploaded_data())

1. 在检查文件是否上传、UI 是否呈现等时使用req()。这是最佳实践。

您的代码：

if(is.null(input$file1)) return()

替换代码：

req(input$file1)

1. 过滤不起作用。基本上为什么它不起作用是它试图根据比较来自input$choose_column和input$column_value的两个字符串来进行子集化。

即：“列名 A”！=“值：某物”

它通常为每一行返回TRUE，最终根本没有过滤。

我想出了 2 个解决方案，它们有点难看，所以如果有人提出更好的解决方案，请随时评论/编辑。

#server.R
library(shiny)
function(input, output) {

  uploaded_data <- reactive({
    inFile <- input$file1
    read.table(inFile$datapath, header=input$header, sep=input$sep, quote=input$quote)
  })

  react_vals <- reactiveValues(data = NULL)

  output$choose_columns <- renderUI({
    req(input$file1)

    colnames <- names(uploaded_data())
    checkboxGroupInput("choose_columns", "Choose columns", 
                       choices  = colnames,
                       selected = colnames)
  })

  output$choose_column <- renderUI({
    req(input$file1)
    is_factor <- sapply(uploaded_data(), is.factor)
    colnames <- colnames(uploaded_data()[is_factor])
    selectInput("choose_column", "Choose column", choices = colnames)
  })

  observeEvent(input$file1, react_vals$data <- uploaded_data())
  observeEvent(input$choose_columns, react_vals$data <- uploaded_data()[, input$choose_columns])

  observeEvent(input$filter, {
    react_vals$data <-
      #Option A
      eval(parse(text = sprintf("subset(uploaded_data(), %s != '%s')", input$choose_column, input$column_value)))

      #Option B
      #subset(uploaded_data(), uploaded_data()[, which(names(uploaded_data()) == input$choose_column)] != input$column_value)
  })

  output$contents <- renderTable(react_vals$data)
}

shinyApp(ui, server)