The first half of a dynamic filtering Shiny application.

dynamic_shiny_i_o_example.R

library(shiny)
library(stringr)

# Module UI function
fieldSelectorInput <- function(id) {
  # Create a namespace function using the provided id
  ns <- NS(id)
  
  tags$div(id = ns("id"),
           tagList(
             fluidRow(
               column(12, selectInput(ns("select_input_one"), label = "Filter Variable", choices = c(1,2,3), width = '100%'))
               ),
             fluidRow(
               column(6, actionButton(ns("reshuffle_button"),label = "reshuffle")),
               column(6, actionButton(ns("remove_button"),label = "remove"))
             )
             )
           )
}



# Module server function
# This is the server functionality for a single server function (corresponding to a single UI group of elements)
fieldSelector <- function(input, output, session, div_instance) {
  
  to_return <- reactive({
    
    input$reshuffle_button[1]
    input$remove_button[1]
    
    if(!is.null(input$remove_button)){
      if(input$remove_button > 0) {return(NULL)} else{
        return(sample(1:32, 5, replace = FALSE))
      }
    } else{
      
      return(NULL)
      
    }
    

    
  })
  
  
  
  observeEvent(input$remove_button, once = TRUE, {
    
    to_remove <- glue::glue("#{div_instance}")
    
    removeUI(
      selector = to_remove
    )
    

  })

  return(to_return)

}


# -----

# Define UI
ui <- fluidPage(
  # fieldSelectorInput("basic_field"),
  # fieldSelectorInput("basic_field_two"),
  tags$div(id = "content_filter"),
  fluidRow(actionButton("create_new_filter", label = "Create New Filter")),
  fluidRow(textOutput("values")),
  fluidRow(textOutput("names"))
  )

# Server logic
server <- function(input, output, session) {

  # Initialize the "all_values" list, which is where you will put the filters you create
  all_values <- reactiveValues()
  
  
  observeEvent(input$create_new_filter, {

  # Name the new filter
  title <- glue::glue("field_selector_{input$create_new_filter}")
  
  # Create and insert the UI for the new filter
  insertUI(selector = '#content_filter', ui = fieldSelectorInput(title), where = "beforeEnd")
  
  # Add the new filter's return value to the all_values list
  # The callModule call also instantiates the server-side behavior of the new server.
  # It does so inside its own scope, which helps to keep it sandboxed from other filters.
  # You have to pass the information you want this server to use to it as reactiveValues, and you
  # can only use values passed back as a reactive value from the server (if you want multiple things returned,
  # you need to pass them in a list)
  all_values[[title]] <- callModule(fieldSelector, id = title, div_instance = glue::glue("{title}-id"))

  })

  
  # You end up with a reactiveValues element called "all_values" that has for its entries
  # functions.  You need to execute these funcitons to access the values.  You can do this for
  # the whole set of functions using invoke_map (after converting the reactiveValues object to a list)
  
  list_of_elements <- reactive({
    
    list_version <- reactiveValuesToList(all_values)
    
    purrr:::invoke_map(list_version)
    
  })
  
  
  # This just displays the values of the output.  This is just to show what's there.  You'll want to use this information differently.
  output$values <- renderText({
    
    unlist(list_of_elements())
    
  })
  
  
  # This just displays the names of the values of the output.  Note that a "removed" filter is not removed from the "all_values" list; its value is 
  # just set to NULL.  This isn't problematic, I don't think... you'll just want to ensure that you ignore NULL values (or you could set the value to 
  # something like "Deleted."  Just something to separate it.)
  output$names <- renderText({
    
    list_version <- reactiveValuesToList(all_values)
    
    names(list_of_elements())
    
  })

}

# Complete app with UI and server components
shinyApp(ui, server)