如何在 R 闪亮的数据表顶部添加过滤器？

Question

这个闪亮的应用程序概述： 这个闪亮的应用程序采用多个 .xpt 文件，并在面板左侧创建基于列的过滤器（STUDYID、DOMAIN、VALUE、SEQ）。 我不想使用侧面板，而是想将列过滤器移动到数据表的顶部以匹配其列。

注意：阅读我之前的文章后，这是扩展的问题：如何在 R闪亮中显示多个.xpt文件并根据它们的列过滤它们？

数据：

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

代码

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", "SEQ")
  
  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),
      numericInput("SEQ", "SEQ", value = NA)
    )
  })
  
  output$tables <- renderUI({
    req(df())
    map(1:length(df()), ~ tableOutput(str_c("table", .x)))
  })
  
  observeEvent(c(input$STUDYID, input$DOMAIN, input$VALUE, input$SEQ), {
    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)