如何通过 R Shiny 应用程序的服务器部分中的循环动态创建反应性数据集？

Question

首先，这是一个通用问题，我希望有知识的人能够指出我实现我想做的方法的正确方向。因此，我没有可重现的示例要分享，但我将提供一些示例代码，希望能理解我正在尝试做的事情。

我有一个 R Shiny 仪表板应用程序。此应用程序使用在全球环境中生成的许多不同数据集（即不在服务器内）。在服务器中，需要根据用户输入对每个数据集应用过滤器。因此，这些数据集是被动的。

我目前对每个数据集都有单独的代码块，如下面的示例代码所示。这行得通。但是，我希望对此进行动态编程，这样我就可以将相同的代码应用于数据集列表，而无需为每个数据集单独复制和编辑相同的代码块。

下面是当前代码块的示例。他们调用处理数据集的过滤器函数。例如，代码的后面部分可以调用“filtered_data_apple()”，并且可以按预期工作。

 filtered_data_apple <- reactive({
    data <- filter_data('apple',as.data.table(df_apple))
    data
  })
  filtered_data_banana <- reactive({
    data <- filter_data('banana',as.data.table(df_banana))
    data
  })
  filtered_data_cherry <- reactive({
    data <- filter_data('cherry',as.data.table(df_cherry))
    data
  })

我想要的是能够提供一个列表（在这个例子中是水果），并让服务器循环遍历它们并将相同的代码块应用到所有它们以及代码的其他部分能够调用他们生成的数据集而不会出现任何错误。

下面的代码不起作用，但希望能证明我正在尝试做的事情：

for (fruit in c('apple','banana','cherry')){
   filtered_data_name <- paste('filtered_data_',fruit,sep="")
   df_name <- paste('df_',fruit,sep="")
   assign(filtered_data_name,
            reactive({
              data <- filter_data(fruit,as.data.table(get(df_name)))
              data
            })
   )
}

我相信上述方法失败是因为在 Shiny 服务器中评估代码时。我认为“fruit”的值在每次迭代中最终都是相同的（列表中的最后一个值，“cherry”）。所以它适用于“樱桃”数据集，但仅此而已。我也尝试在本地语句中包含循环内的代码，但这不起作用，因为生成的数据集仍然包含在本地环境中，并且不能从外部调用。我也尝试过使用重复循环，但由于与 for 循环相同的原因，它也失败了。在所有迭代中，fruit 的值将是“cherry”。

希望我已经足够清楚地传达这个问题，我希望有人能够提供正确的方法来解决这个问题。肯定有什么吧？

谢谢！

编辑：为清楚起见，数据集可以包含彼此完全不同的列。因此，为什么它们是单独的数据集。它们也是非常大的数据集，所以我想限制正在进行的过滤量，以便它为该数据集过滤一次，而不是每次调用都过滤一个更大的数据集，这需要更长的运行时间。

Answer 1

这是一个基于模块的可行解决方案。

模块由filteredDataUI 和filteredDataServer 函数定义。 filteredDataUI 在wellPanel 中呈现两个selectInputs 和一个dataTableOutput。当模块传递一个数据框时，selectInputs 包含列名和所选列的值。选择值（或值）时，将过滤表只显示包含该列中的这些值的行。

模块的使用允许相同的代码重复用于不同的数据帧，并从主程序流程中移除过滤逻辑。模块服务器和模块 UI 函数的 id 参数允许模块的单独实例处理不同的数据帧。

可以以这种方式显示任意数量的数据帧：只需为每个数据帧定义一个单独的模块实例。

library(shiny)
library(tidyverse)

# Module UI
filteredDataUI <- function(id, label) {
  ns <- NS(id)
  wellPanel(
    label,
    selectInput(ns("fieldName"), "Select a column", choices=c()),
    selectInput(ns("fieldValues"), "Select values", choices=c(), multiple=TRUE),
    dataTableOutput(ns("table"))
  )
}

# Module server
filteredDataServer <- function(id, data) {
  moduleServer(
    id,
    function(input, output, session) {
      # Populate column names
      observe({
        updateSelectInput(session, "fieldName", choices=names(data))
      })
      
      # Update field values on change of field name
      observeEvent(input$fieldName, {
        req(input$fieldName)
        
        valueList <- data %>% select(one_of(input$fieldName)) %>% distinct() %>% arrange() %>% pull()
        updateSelectInput(session, "fieldValues", choices=valueList, selected=NULL)
      })
      
      # Filter the input data
      filteredData <- reactive({
        if (is.null(input$fieldValues)) {
          data
        } else {
          idx <- which(names(data) == input$fieldName)
          valueList <- input$fieldValues
          data %>% filter(data[[idx]] %in% valueList)
        }
      })
      
      # Render the filtered table
      output$table <- renderDataTable({ filteredData() }, options=list("pageLength"=5))
    
      # Return the filtered data to the app.  Note that the reactive is returned,
      # not its value
      return(filteredData)
    }
  )
}

ui <- fluidPage(
  wellPanel(
    fluidRow(
      column(width=6, textOutput("data1Text")),
      column(width=6, textOutput("data2Text"))
    )
  ),
  filteredDataUI("data1", "The mtcars data frame"),
  filteredDataUI("data2", "The diamonds data frame"),
)

server <- function(input, output) {
  # Define the modules
  fd1 <- filteredDataServer("data1", mtcars)
  fd2 <- filteredDataServer("data2", diamonds)
  
  # React to changes in module return values
  output$data1Text <- renderText({
    paste0("mtcars contains ", fd1() %>% nrow(), " rows after filtering.")
  })
  output$data2Text <- renderText({
    paste0("diamonds contains ", fd2() %>% nrow(), " rows after filtering.")
  })
}

shinyApp(ui = ui, server = server)

编辑于 07May21 以包含 cmets 并演示在应用程序的主服务器功能中使用模块返回值。