如何在 R闪亮中显示多个.xpt文件并根据它们的列过滤它们？

当我尝试上传多个 .xpt 文件以在 R闪亮应用程序的主面板中显示表格时，它给我带来了以下问题。

我也在寻找过滤选项。我想在上传多个文件时按列进行过滤，以便在每个数据框/数据表的主面板中显示适当的行。

Error: Warning: Error in This kind of input is not handled

有人可以帮我解决问题吗？

code:

library(shiny)
library(haven)

ui <- fluidPage(
  sidebarLayout(
    sidebarPanel(
      fileInput("file1", "Choose CSV File", multiple = TRUE,
                accept = c(
                  "text/csv",
                  "text/comma-separated-values,text/plain",
                  ".csv", ".xpt")
      ),
      tags$hr(),
      checkboxInput("header", "Header", TRUE)
    ),
    mainPanel(
      tableOutput("contents")
    )
  )
)

server <- function(input, output) {
  # output$contents <- renderTable({
  #   # input$file1 will be NULL initially. After the user selects
  #   # and uploads a file, it will be a data frame with 'name',
  #   # 'size', 'type', and 'datapath' columns. The 'datapath'
  #   # column will contain the local filenames where the data can
  #   # be found.
  #   inFile <- input$file1
  #   
  #   if (is.null(inFile))
  #     return(NULL)
  #   
  #   read.csv(inFile$datapath, header = input$header)
  # })
  
  output$contents <- renderTable({
    # input$file1 will be NULL initially. After the user selects
    # and uploads a file, it will be a data frame with 'name',
    # 'size', 'type', and 'datapath' columns. The 'datapath'
    # column will contain the local filenames where the data can
    # be found.
    inFile <- input$file1
    
    if (is.null(inFile))
      return(NULL)
    
    read_xpt(inFile$datapath) 
  })
  
}

shinyApp(ui, server)

Xpt1:

STUDYID   DOMAIN    CR_VALUE
1           CR        1.5
2           CR        1.5
3           CR        1.5

Xpt2:

STUDYID   DOMAIN    CM_VALUE
1           CM        1.5
2           CM        1.8
3           CR        1.9

使用值 1.9 进行过滤后，这是预期的输出。

3           CR        1.9

上传多个文件时应用程序开始失败的原因是inFile$datapath不再是单一值。现在它包含与每个文件对应的多个数据路径。

下面是一个示例应用程序，允许用户上传多个 .xpt 文件并选择要在表格上显示的文件。

library(shiny)
library(haven)
library(stringr)

ui <- fluidPage(
  sidebarLayout(
    sidebarPanel(
      fileInput("file1", "Choose CSV File",
        multiple = TRUE,
        accept = c(
          "text/csv",
          "text/comma-separated-values,text/plain",
          ".csv", ".xpt"
        )
      ),
      tags$hr(),
      checkboxInput("header", "Header", TRUE),
      uiOutput("files_available")
    ),
    mainPanel(
      tableOutput("contents")
    )
  )
)

server <- function(input, output) {
  output$files_available <- renderUI({
    req(input$file1)
    selectInput("name", str_to_title("select which file to show"), choices = input$file1$name)
  })

  df <- reactive({
    req(input$name)
    read_xpt(input$file1$datapath[[which(input$file1$name == input$name)]])
  })

  output$contents <- renderTable({
    df()
  })
}

shinyApp(ui, server)

编辑：带有过滤器的应用程序：

library(shiny)
library(haven)
library(stringr)
library(shinyWidgets)
library(tidyverse)

ui <- fluidPage(
  sidebarLayout(
    sidebarPanel(
      fileInput("file1", "Choose CSV File",
        multiple = TRUE,
        accept = c(
          "text/csv",
          "text/comma-separated-values,text/plain",
          ".csv", ".xpt"
        )
      ),
      tags$hr(),
      checkboxInput("header", "Header", TRUE),
      uiOutput("files_available"),
      uiOutput("filters")
    ),
    mainPanel(
      uiOutput("tables")
    )
  )
)

server <- function(input, output) {
  nms <- reactiveVal(NULL)

  suffixes <- c("STUDYID", "DOMAIN", "VALUE")

  df <- reactive({
    req(input$file1)
    input$file1$datapath %>%
      map(~ read_xpt(.x))
  })

  # for debugging
  observe({
    print(df())
    # print(nms())
    # print(map(names(input), ~input[[.x]]))
  })


  observeEvent(df(), {
    nms(map(df(), names))
  })

  output$filters <- renderUI({
    req(df())
    inpts <- tagList(
      numericInput("STUDYID", "STUDYID", value = NA),
      textInput("DOMAIN", "DOMAIN", value = ""),
      numericInput("VALUE", "VALUE", value = NA)
    )
  })

  output$tables <- renderUI({
    req(df())
    map(1:length(df()), ~ tableOutput(str_c("table", .x)))
  })

  observeEvent(c(input$STUDYID, input$DOMAIN, input$VALUE), {
    df <- df()
    # df contains multiple dataframes so we need to loop through each of them to create the render functions
    walk(1:length(df), ~ {
      output[[str_c("table", .x)]] <<- renderTable({
        cur_df <- df[[.x]]
        nms <- nms()[[.x]]
        nms <- map(suffixes, ~ str_subset(nms, .)) # to order the correct column names with the required input. Warning, if more than one name matches the suffix is not tested
        # first we look if the input is character type and force a NA value on it, if it's not we just look for NA.
        # If the input is not NA (meaning that is has a value inserted by the user), then filter the table by that value.
        walk2(nms, suffixes, ~ {
          if (class(input[[.y]]) == "character") {
            if (input[[.y]] == "") {
              input_value <- NA
            } else {
              input_value <- input[[.y]]
            }
          } else {
            input_value <- input[[.y]]
          } # empty textInput's show has an empty string value instead of NA
          print(input_value)
          if (!is.na(input_value)) {
            cur_df <<- cur_df %>% filter(.data[[.x]] == input[[.y]])
          }
        })
        cur_df
      })
    })
  })
}

shinyApp(ui, server)