Listening to multiple events in R shiny app

Question

I am new to shiny app development and still trying to understand how the different reactive/observe functions work. Here, I am trying to create a simple app that lists the entire dataframe if a checkbox is checked. Otherwise, if the checkbox is not checked and some variables are selected, summaries are generated for each variable that is selected.

The issue I'm having is that the data is never listed even when the box is checked. And the summaries are still displayed when the checkbox is rechecked. Also, the summaries do not respond to addition of new variables unless the checkbox is checked again and unchecked. I'd appreciate some help. Below is my code:

  summ <- function(dt,var){
  if(is.numeric(dt[[var]])){
    dt %>% group_by(.data$gear) %>% summarise(n=sum(!is.na(.data[[var]])),
                                                mean=mean(.data[[var]],na.rm = T))
  }else{
    dt %>% group_by(.data$gear, .data[[var]]) %>% summarise(n=sum(!is.na(.data[[var]]))) %>% 
      mutate(levels=.data[[var]], proportion=n*100/sum(n))
  }
}

ui <- fluidPage(
  
  titlePanel("Test app"),
  
  sidebarLayout(
    sidebarPanel(
      selectInput("var", "Select variable to summarize", choices = names(mtcars),multiple = T),
      checkboxInput('list','Select to see listing',value = T)
    ),
    
    mainPanel(
      uiOutput("outp")
    )
  )
)

server <- function(input, output,session) {
  
  toListen <- reactive({list(input$var,input$list)})
  observeEvent(input$list,{
    if(input$list==T){renderTable({mtcars})}
    else {
      req(input$var)
      max_table <- length(input$var)
      tab <- list()
      for (i in 1:length(input$var)) {
        tab[[i]] <- summ(mtcars,input$var[i])
        
      }
      
      output$outp <- renderUI({
        output_list <- lapply(1:max_table, function(i) {
          tablename <- paste("tablename", i, sep = "")
          tableOutput(tablename)
        })
        do.call(tagList, output_list)
        
      })
      for (i in 1:max_table) {
        local({
          my_i <- i
          tablename <- paste("tablename", my_i, sep = "")
          output[[tablename]] <- renderTable({
            tab[[my_i]]
          })
        })
      }
    }
    
  })
}
shinyApp(ui = ui, server = server)

Answer 1

I think this gives you what you need. I'd consider using modules to create the summary tables in a production app.

library(tidyverse)

summ <- function(dt,var){
  if(is.numeric(dt[[var]])){
    dt %>% group_by(.data$gear) %>% summarise(n=sum(!is.na(.data[[var]])),
                                              mean=mean(.data[[var]],na.rm = T))
  }else{
    dt %>% group_by(.data$gear, .data[[var]]) %>% summarise(n=sum(!is.na(.data[[var]]))) %>% 
      mutate(levels=.data[[var]], proportion=n*100/sum(n))
  }
}

ui <- fluidPage(
  
  titlePanel("Test app"),
  
  sidebarLayout(
    sidebarPanel(
      selectInput("var", "Select variable to summarize", choices = names(mtcars),multiple = T),
      checkboxInput('list','Select to see listing',value = T)
    ),
    
    mainPanel(
      uiOutput("outp")
    )
  )
)

server <- function(input, output,session) {
  # renderUI simply defines the requested output widgets: you need to populate
  # them elsewhere
  output$outp <- renderUI({
    if (input$list) {
      # Source listing
      dataTableOutput("sourceTable")
    } else {
      # Summary tables for selected columns
      tagList(
        lapply(
          input$var, 
          function(vname) {
            dataTableOutput(paste0("summary", vname))
          }
        )
      )
    }
  })
  
  # Populate the requested output widgets
  
  output$sourceTable <- renderDataTable({ mtcars })
  # Set up output objects for all columns in mtcars.  They appear only if the 
  # corresponding dataTableOutput is created in the renderUI above.  This is
  # sloppy, but it works and keeps the example simple.
  lapply(
    names(mtcars),
    function(vname) {
      output[[paste0("summary", vname)]] <- renderDataTable({ summ(mtcars, vname)})
    }
  )
}

shinyApp(ui = ui, server = server)