R语言 根据用户文件上传的用户输入动态数量筛选数据集

tyu7yeag  于 2023-02-01  发布在  其他
关注(0)|答案(1)|浏览(135)

我正在制作一个闪亮的应用程序,用户应该能够上传文件,然后根据唯一值过滤数据集(级别)的所有字符列在上传的文件。我能够动态生成正确的pickerInputselectInput)元素,但是我在执行筛选时遇到了问题。我使用了下面的链接作为指导,但是我在弄清楚如何获取所选值时遇到了问题(我想input[[paste0("level", .y)]]就是我的问题所在)。
Filter the input of another input with unknown length in R Shiny
输入CSV文件

structure(list(factorGroup1 = c("A", "A", "A", "A", "B", "B", 
"B", "B", "C", "C", "C", "C"), factorGroup2 = c("D", "D", "E", 
"E", "D", "D", "E", "E", "D", "D", "E", "E"), factorGroup3 = c("F", 
"G", "F", "G", "F", "G", "F", "G", "F", "G", "F", "G"), numVar = c(5L, 
8L, 1L, 6L, 3L, 4L, 9L, 5L, 8L, 7L, 5L, 3L)), class = "data.frame", row.names = c(NA, 
-12L))

应用程序代码

library(shiny)
library(data.table)
library(ggplot2)
library(dplyr)

ui <- fluidPage(
  
  headerPanel("Dynamic number of plots"),
  
  sidebarPanel(
    fileInput("fileIn", 
              "Load input file",
              multiple = F)
  ),
  
  mainPanel(
    uiOutput("generateFilters"),
    tableOutput("dataOut")
  )
)

server <- function(input, output) {
  
  getData <- reactive({
    req(input$fileIn)
    dataIn <- as.data.frame(fread(input$fileIn$datapath))
    return(dataIn)
  })
  
  output$generateFilters <- renderUI({
    lapply(names(Filter(is.character, getData())), function(i) {
      
      filterLevels <- unique(getData()[,i])
      shinyWidgets::pickerInput(inputId = paste(i),
                                label = paste(i),
                                choices = filterLevels,
                                multiple = T,
                                options = list(`actions-box` = T),
                                selected = filterLevels)
    })
  })
  
  dataFxn <- reactive({
    purrr::reduce(seq_along(input$generateFilters), 
                  ~ filter(.x, .data[[ input$generateFilters[[.y]] ]] %in% 
                             input[[paste0("level", .y)]]), 
                  .init = getData())
  })
  
  output$dataOut <- renderTable({
    dataFxn()
  })
  
  }

shinyApp(ui, server)
jogvjijk

jogvjijk1#

您引用的帖子中的示例逻辑稍有不同,并且使用了一些错误的符号,例如,既有一个名为varinput,又有一个名为varoutput。要使答案中的解决方案适用于您的案例,需要进行一些调整。即,对于reduce,我们必须像在lapply中那样在names(Filter(is.character, getData()))上循环,并且在函数内部,我们必须执行filter(.x, .data[[ .y ]] %in% input[[.y]])以过滤数据。

library(shiny)
library(purrr)
library(dplyr)

ui <- fluidPage(
  headerPanel("Dynamic number of plots"),
  sidebarPanel(
    fileInput("fileIn",
      "Load input file",
      multiple = F
    )
  ),
  mainPanel(
    uiOutput("generateFilters"),
    tableOutput("dataOut")
  )
)

server <- function(input, output) {
  getData <- reactive({
   dataIn
  })

  output$generateFilters <- renderUI({
    lapply(names(Filter(is.character, getData())), function(i) {
      filterLevels <- unique(getData()[, i])
      shinyWidgets::pickerInput(
        inputId = paste(i),
        label = paste(i),
        choices = filterLevels,
        multiple = T,
        options = list(`actions-box` = T),
        selected = filterLevels
      )
    })
  })

  dataFxn <- reactive({
    purrr::reduce(names(Filter(is.character, getData())), function(.x, .y) {
      filter(.x, .data[[ .y ]] %in% input[[.y]])  
    },
      .init = getData()
    )
  })

  output$dataOut <- renderTable({
    dataFxn()
  })
}

shinyApp(ui, server)

相关问题