Modularize reactiveUI with interdependent filters in shiny with {golem}

Question

The following shiny app works well but has a problem: it displays errors or warnings because of the dynamic filtering.

library(shiny)
ui <- dashboardPage(
   dashboardHeader(),
   dashboardSidebar(
       titlePanel(
           div(style="line-height: 100%",
               align = 'center',
               span("Awesome reprex"),
               hr()
               )
           ),
       sidebarMenu(
           menuItem("Home", tabName = "Home", icon = icon("fas fa-home")),
           menuItem("Main section", tabName = "Main", icon = icon("far fa-chart-bar"))
       )
   ),
   dashboardBody(
       
       tabItems(tabItem(tabName = "Home"),
           
           tabItem(tabName = "Main",
                   fluidRow(
                   ),

                   fluidRow(),
                   hr(),

                   fluidRow(style = 'background: white;',
                            div(
                                box(
                                    title= "Much filters",
                                    style = 'height:420px; background: gainsboro; margin-top: 5vw;',
                                    width=3,
                                    solidHeader = TRUE,
                                    uiOutput("continent"),
                                    uiOutput("country")
                                ),
                                tabBox(
                                    width = 9,
                                    title = "Results",
                                    id = "tabset1",
                                    tabPanel(style = 'overflow-y:scroll;height:420px;',"Awesome results !",
                                             style="zoom: 90%;",
                                             DT::dataTableOutput("awesometable")
                                    )
                                )
                            )
                   )
           )
           )
       )
   )



library(data.table)
library(shiny)
library(gapminder

server <- function(input, output, session) {
   
   df <- gapminder::gapminder
   
   output$continent = renderUI({
       selectizeInput(inputId = "continent",
                      label = "Continent :",
                      choices = unique(df[,"continent"]),
                      selected = unique(df[,"continent"])[1])
   })
   # #
   datasub <- reactive({
       df[df$continent == input$continent,]
   })

   output$country = renderUI({
       selectizeInput(inputId = "country",
                      label = "Country :",
                      choices = unique(datasub()[,"country"])
       )
   })
   # 
   datasub2 <- reactive({
       datasub()[datasub()$country == input$country, ]
   })
   
   output$awesometable <- DT::renderDataTable({
       
       datasub2()
   })
}


shinyApp(ui, server)

First part of the problem: Errors started displaying once I included a filtering method I found here: https://stackoverflow.com/a/51153769/12131069

After trying different methods, this is the one that works pretty close to what I am looking for.

However, once the app is loaded, this appears in the console:

Logical subscripts must match the size of the indexed input. Input has size 392 but subscript datasub2()$country== input$country has size 0.

Second part of the problem: The app is being developed with the {golem} package, which is really helpful when building scalable and maintainable shiny infrastructure. However, I don't get what I am expecting (and I get the errors). How can I solve that? How can I "modularize" the workaround I found to create interdependent filters?

I have been trying something like:

#' awesome_app_ui UI Function
#'
#' @description A shiny Module.
#'
#' @param id,input,output,session Internal parameters for {shiny}.
#'
#' @noRd 
#'
#' @import DT
#' @import plotly
#' @import htmltools
#' @import shinydashboard
#' @importFrom reactable JS
#' @importFrom shiny NS tagList 
mod_chiffres_cles_ts_ui <- function(id){
  
  ns <- NS(id)
  
  df <- gapminder::gapminder

tabBox(width = 9,title = "Results",d = "tabset1",
tabPanel(style = 'overflow-y:scroll;height:420px;',"Awesome results !",
style="zoom: 90%;",DT::dataTableOutput("awesometable"))
  
  
}

#' awesome_app Server Functions
#'
#' @noRd 
mod_chiffres_cles_ts_server <- function(id){
  moduleServer( id, function(input, output, session){
    ns <- session$ns

df <- gapminder::gapminder

   output$continent = renderUI({
       selectizeInput(inputId = "continent",
                      label = "Continent :",
                      choices = unique(df[,"continent"]),
                      selected = unique(df[,"continent"])[1])
   })
   # #
   datasub <- reactive({
       df[df$continent == input$continent,]
   })

   output$country = renderUI({
       selectizeInput(inputId = "country",
                      label = "Country :",
                      choices = unique(datasub()[,"country"])
       )
   })
   # 
   datasub2 <- reactive({
       datasub()[datasub()$country == input$country, ]
   })

   output$awesometable <- DT::renderDataTable({

       datasub2()
   })
}

Thanks!

YBS · Accepted Answer · 2021-08-10T12:19:26.747

Once you use req() appropriately, your program works fine.

library(shiny)
library(data.table)
library(shiny)
library(gapminder)

ui <- dashboardPage(
  dashboardHeader(),
  dashboardSidebar(
    titlePanel(
      div(style="line-height: 100%",
          align = 'center',
          span("Awesome reprex"),
          hr()
      )
    ),
    sidebarMenu(
      menuItem("Home", tabName = "Home", icon = icon("fas fa-home")),
      menuItem("Main section", tabName = "Main", icon = icon("far fa-chart-bar"))
    )
  ),
  dashboardBody(
    
    tabItems(tabItem(tabName = "Home"),
             
             tabItem(tabName = "Main",
                     fluidRow(
                     ),
                     
                     fluidRow(),
                     hr(),
                     
                     fluidRow(style = 'background: white;',
                              div(
                                box(
                                  title= "Much filters",
                                  style = 'height:420px; background: gainsboro; margin-top: 5vw;',
                                  width=3,
                                  solidHeader = TRUE,
                                  uiOutput("continent"),
                                  uiOutput("country")
                                ),
                                tabBox(
                                  width = 9,
                                  title = "Results",
                                  id = "tabset1",
                                  tabPanel(style = 'overflow-y:scroll;height:420px;',"Awesome results !",
                                           style="zoom: 90%;",
                                           DT::dataTableOutput("awesometable")
                                  )
                                )
                              )
                     )
             )
    )
  )
)

server <- function(input, output, session) {
  
  df <- gapminder::gapminder
  
  output$continent = renderUI({
    selectizeInput(inputId = "continent",
                   label = "Continent :",
                   choices = unique(df[,"continent"]),
                   selected = unique(df[,"continent"])[1])
  })
  
  datasub <- reactive({
    req(input$continent)
    df[df$continent == input$continent,]
  })
  
  output$country = renderUI({
    req(datasub())
    selectizeInput(inputId = "country",
                   label = "Country :",
                   choices = unique(datasub()[,"country"])
    )
  })
  
  datasub2 <- reactive({
    req(datasub(),input$country)
    datasub()[datasub()$country == input$country, ]
  })
  
  output$awesometable <- DT::renderDataTable({
    req(datasub2())
    datasub2()
  })
}

shinyApp(ui, server)

You can also use modules as shown below. You may need to adjust where you want to place your selectInputs.

library(shiny)
library(data.table)
library(shiny)
library(gapminder)

moduleServer <- function(id, module) {
  callModule(module, id)
}

mod_chiffres_cles_ts_ui <- function(id){

  ns <- NS(id)
  tagList(
    box(
      title= "Filter",
      style = 'height:420px; background: gainsboro; margin-top: 3vw;',
      #width=3,
      solidHeader = TRUE,
      uiOutput(ns("mycontinent"))
    )
  )
}

mod_chiffres_cles_ts_server <- function(id,dat,var){
  moduleServer( id, function(input, output, session){
    ns <- session$ns
    df <- isolate(dat())
    
    output$mycontinent = renderUI({
      selectizeInput(inputId = ns("continent"),
                     label = paste(var, ":"),
                     choices = unique(df[,var]),
                     selected = unique(df[,var])[1])
    })
    
    #print(var)
    return(reactive(input$continent))

  })
}

mod_chiffres_cles_ds_server <- function(id,dat,var,value){
  moduleServer( id, function(input, output, session){
    
    df <- isolate(dat())
 
    datasub <- reactive({
      val = as.character(value())
      df[df[[as.name(var)]] == val,]
    })
    
    #print(var)
    return(reactive(as.data.frame(datasub())))
    
  })
}

ui <- dashboardPage(
  dashboardHeader(),
  dashboardSidebar(
    titlePanel(
      div(style="line-height: 100%",
          align = 'center',
          span("Awesome reprex"),
          hr()
      )
    ),
    sidebarMenu(
      menuItem("Home", tabName = "Home", icon = icon("fas fa-home")),
      menuItem("Main section", tabName = "Main", icon = icon("far fa-chart-bar"))
    )
  ),
  dashboardBody(
    
    tabItems(tabItem(tabName = "Home"),
             
             tabItem(tabName = "Main", 
                     fluidRow(
                       column(6,mod_chiffres_cles_ts_ui("gap1"), 
                              mod_chiffres_cles_ts_ui("gap2") 
                              ),
                       column(6,style = 'background: white;',
                              div(
                                tabBox(
                                  width = 12,
                                  title = "Results",
                                  id = "tabset1",
                                  tabPanel(style = 'overflow-y:scroll;height:560px;',"Awesome results !",
                                           style="zoom: 90%;",  
                                           DTOutput("awesometable")
                                  )
                                )
                              )
                              )
                             
                     )
             )
    )
  )
)


server <- function(input, output, session) {
  dfa <- reactive(gapminder)
  session$userData$settings <- reactiveValues(df1=NULL,df2=NULL)
  rv <- reactiveValues()
  var1 <- mod_chiffres_cles_ts_server("gap1",dfa,"continent")
  
  observeEvent(var1(), {
    data1 <- mod_chiffres_cles_ds_server("gap1",dfa,"continent", var1 )
    session$userData$settings$df1 <- data1()
    var21 <- mod_chiffres_cles_ts_server("gap2",data1,"country")
    df21 <- mod_chiffres_cles_ds_server("gap2",data1,"country", var21 )
    session$userData$settings$df2 <- df21()
    print(var21)
  })
  
  df22 <- reactive(session$userData$settings$df1)
  var22 <- mod_chiffres_cles_ts_server("gap2",df22,"country")
  
  observeEvent(var22(), {
    print(var22())
    data2 <- mod_chiffres_cles_ds_server("gap2",df22,"country",var22)
    session$userData$settings$df2 <- data2()
  })

  output$awesometable <- renderDT({
    datatable(session$userData$settings$df2)
  })
  
}

shinyApp(ui, server)

Hi YBS, Thanks for your answer! It solved the first problem. I am almost sure I heard about this function but never implemented it before. Regarding the second part: the app is much bigger than the code shown here. Globally: to avoid spaghetti code and make updates faster (and reliable). I made a skeleton of the structure with multiple functions and modules. I want to modularize this part for two reasons: 1) stick to the design I made and 2) use the same filters but with other datasets in other parts of the app. Am I overthinking the problem? Feel free to suggest other approaches! — Luis, Aug 09 '21 at 21:12
Agree that modules will be better if you are going to use it repeatedly. Let me take a crack at it. — YBS, Aug 09 '21 at 23:21
Exactly! This is what I was looking for. Still deciphering what happens on the server side so I can apply it to my case though. Also, I needed to add shinydashboard and DT to the libraries to make your code work. Anyway. Your solution is teaching me a lot and gave me new ideas for the structure. Thanks! — Luis, Aug 10 '21 at 11:57

Modularize reactiveUI with interdependent filters in shiny with {golem}

1 Answers1