How can I create reactive datasets dynamically via a loop in the server section of an R Shiny app?

Question

First off, this is a generic question that I'm hoping someone knowledgeable will be able to point me in the right direction of a method to achieve what I'm wanting to do. As such I don't have a reproducible example to share, but I will provide some example code that hopefully gets across what I'm trying to do.

I have an R Shiny dashboard app. This app uses a number of different datasets which are generated in the global environment (i.e. not within the server). Within the server, a filter needs to be applied to each dataset depending on user input. Hence, these datasets are reactive.

I currently have separate blocks of code for each dataset, like in the example code below. This works. However, I am looking to program this dynamically, so that I can apply the same code to a list of datasets without having to copy and edit the same chunks of code for each one individually.

Below is an example of what the chunks of code look like at the moment. They call a filter function which processes the dataset. Later parts of the code can makes calls to "filtered_data_apple()" for example, and it works as expected.

 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
  })

What I want is to be able to provide a list (of fruits in this example) and for the server to loop through them and apply the same chunk of code to all of them and for other parts of the code to be able to call the datasets they produce without any errors.

The below code does NOT work, but hopefully demonstrates what I'm trying to do:

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
            })
   )
}

The above method fails I believe because of when the code is evaluated in the Shiny server. I think the value of "fruit" ends up being the same (the last value in the list, "cherry") over each iteration. So it will work for the "cherry" dataset, but nothing else. I've tried encompassing the code within the loop within a local statement also, but that doesn't work because the resulting datasets remain contained within the local environment, and cannot be called from outside it. I've also tried using a repeat loop, but it too fails for the same reason as the for loop. The value of fruit would be "cherry" across all iterations.

Hopefully I've been clear enough to convey this problem, and I'm hoping someone will be able to provide the right method to get around this. There must be something, surely?

Thanks!

EDIT: For clarity, the datasets can contain completely different columns to one another. Hence why they are separate datasets. They are also very large datasets, so I wanted to limit the amount of filtering going on, so that it filters it once for that dataset, rather than filtering a larger dataset each time it is called which takes a lot longer to run.

Answer 1

Here's a posible solution based on modules.

The module is defined by the filteredDataUI and filteredDataServer functions. filteredDataUI presents two selectInputs and a dataTableOutput in a wellPanel. When the module is passed a data frame, the selectInputs contain the column names and the values of the selected column. When a value (or values) is selected, the table is filtered to display only rows containing those values in that column.

The use of a module allows the same code to be reused for different data frames, and removes the filtering logic from the main program flow. The id parameter to both module server and module UI functions allows separate instances of the module to handle different data frames.

Any number of data frames can be displayed in thsi way: just define a separate instance of the module for each data frame.

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)

Edited 07May21 to include comments and demonstrate use of module return values in the app's main server function.