Access dataframes created through modules with their names and store them in a list

I am creating an app with modules, based on this answer. Basically, it is an app in which it is possible to create identical tabs with different input names, just by clicking on a tab called More.

Now, I would like to give the user the possibility to merge some (or all) of the tables created. To do so, there is a (permanent) tab called Merge in which there is a checkBoxInput. When no tab is created, this checkBoxInput is empty (since there are no tab and hence no table to select). When one tab and therefore one table are created, I would like the checkBoxInput to be updated to display a box and the name corresponding to this table. For example, if I create 3 tabs, then there should be 3 boxes in the checkBoxInput.

My idea so far was to store the tables created in a list and to update checkBoxInput with the content of this list each time a tab and a table are created. However, I don't know how to obtain the name of the tables created in a module. Since the tables are named with x in the module moduleTable, I thought I could just use x but it gives me the following error:

Warning: Error in observeEventHandler: object 'x' not found

Below is a reproducible example:

library(shiny)
library(shinyWidgets)
library(dplyr)

addTab <- function(id) {
  ns <- NS(id)
  tagList(
    selectInput(ns("select"),
                "Choose", 
                choices = colnames(mtcars)),
    tableOutput(ns("table"))
  )
}

moduleTable <- function(input, output, session){
  x <- reactive(select(mtcars, input$select))
  output$table <- renderTable({
    x()
  })
}


ui <- navbarPage(position = "static-top",
                 title = "foo",
                 id = "tabs",
                 tabPanel(title = "Merge",
                          fluidRow(
                            checkboxGroupInput("to_merge",
                                               label = "Tables to merge",
                                               choices = NULL)
                          )),
                 tabPanel(title = "More",
                          icon = icon("plus"),
                          fluidRow()
                          )
)

server <- function(input, output, session) {
  
  count <- reactiveValues(val=0)
  
  dfs <- list()
  
  observeEvent(input$tabs, {
    if (input$tabs == "More"){
      count$val <- count$val+1
      name <- paste0("Name ", count$val)
      insertTab(inputId = "tabs",
                tabPanel(title = name,
                         addTab(paste0("select", count$val))
                ), 
                target = "More", 
                position = "before",
                select = TRUE)
      
      callModule(moduleTable, paste0("select", count$val))
      
      dfs[[count$val]] <- paste0("mtcars$select", count$val)
      # UNCOMMENT THE LINE BELOW AND COMMENT THE LINE ABOVE TO SEE THE PROBLEM
      # tables[[count$val]] <- x
      
      names(dfs[count$val]) <- paste0("df", count$val)
       
      updateCheckboxGroupInput(session = session,
                               inputId = "to_merge",
                               choices = names(dfs))
    }
  })  
}

shinyApp(ui = ui, server = server)

How can I obtain the names of the dataframes created and store them in a reactive list?

Also asked here: r - Access dataframes created through modules with their names and store them in a list - Stack Overflow

Hi @bretauv - have a look on SO - hope it helps.

Hi @bretauv. If I didn't get wrong, you want somethings like this.

library(shiny)
library(shinyWidgets)
library(dplyr)

addTab <- function(id) {
  ns <- NS(id)
  tagList(
    selectInput(ns("select"),
                "Choose", 
                choices = colnames(mtcars)),
    tableOutput(ns("table"))
  )
}

moduleTable <- function(input, output, session){
  x <- reactive(select(mtcars, input$select))
  output$table <- renderTable({
    x()
  })
  return(x)
}


ui <- navbarPage(position = "static-top",
                 title = "foo",
                 id = "tabs",
                 tabPanel(title = "Merge",
                          fluidRow(
                            checkboxGroupInput("to_merge",
                                               label = "Tables to merge",
                                               choices = NULL),
                            tableOutput("table")
                          )),
                 tabPanel(title = "More",
                          icon = icon("plus"),
                          fluidRow()
                 )
)

server <- function(input, output, session) {
  
  count <- reactiveValues(val=0)
  tables <- reactiveValues()
  
  dfs <- list()
  
  observeEvent(input$tabs, {
    if (input$tabs == "More"){
      count$val <- count$val+1
      name <- paste0("Name ", count$val)
      insertTab(inputId = "tabs",
                tabPanel(title = name,
                         addTab(paste0("select", count$val))
                ), 
                target = "More", 
                position = "before",
                select = TRUE)
      
      x <- callModule(moduleTable, paste0("select", count$val))
      tables[[name]] <- x
    }
  })
  
  observe({
    updateCheckboxGroupInput(session = session,
                             inputId = "to_merge",
                             choices = names(tables))
  })
  
  observe({
    req(input$to_merge)
    output$table <- renderTable(map_dfc(input$to_merge, ~{tables[[.x]]()}))
    
  })
}

shinyApp(ui = ui, server = server)
2 Likes

Hi @bretauv. If I didn't get wrong, you want somethings like this.

library(shiny)
library(shinyWidgets)
library(dplyr)

addTab <- function(id) {
  ns <- NS(id)
  tagList(
    selectInput(ns("select"),
                "Choose", 
                choices = colnames(mtcars)),
    tableOutput(ns("table"))
  )
}

moduleTable <- function(input, output, session){
  x <- reactive(select(mtcars, input$select))
  output$table <- renderTable({
    x()
  })
  return(x)
}


ui <- navbarPage(position = "static-top",
                 title = "foo",
                 id = "tabs",
                 tabPanel(title = "Merge",
                          fluidRow(
                            checkboxGroupInput("to_merge",
                                               label = "Tables to merge",
                                               choices = NULL),
                            tableOutput("table")
                          )),
                 tabPanel(title = "More",
                          icon = icon("plus"),
                          fluidRow()
                 )
)

server <- function(input, output, session) {
  
  count <- reactiveValues(val=0)
  tables <- reactiveValues()
  
  dfs <- list()
  
  observeEvent(input$tabs, {
    if (input$tabs == "More"){
      count$val <- count$val+1
      name <- paste0("Name ", count$val)
      insertTab(inputId = "tabs",
                tabPanel(title = name,
                         addTab(paste0("select", count$val))
                ), 
                target = "More", 
                position = "before",
                select = TRUE)
      
      x <- callModule(moduleTable, paste0("select", count$val))
      tables[[name]] <- x
    }
  })
  
  observe({
    updateCheckboxGroupInput(session = session,
                             inputId = "to_merge",
                             choices = names(tables))
  })
  
  observe({
    req(input$to_merge)
    output$table <- renderTable(map_dfc(input$to_merge, ~{tables[[.x]]()}))
    
  })
}

shinyApp(ui = ui, server = server)

Yes, that is exactly what I want! Thanks a lot
Just one thing: do you know if it's possible to add the new boxes below those which already exist? The order of the boxes with your code is Name 3, Name 2, Name 1... (if I create 3 tabs) but I would like it to be Name 1, Name 2, Name 3

I can't edit your post but don't forget to add library(purrr). Also, do you want to put your solution on StackOverflow or do I add it myself?

@raytong in my actual app, the tables I generate have a common column, would it be possible to use full_join instead of map_dfc that just bind columns? I did this:

library(shiny)
library(shinyWidgets)
library(dplyr)

addTab <- function(id) {
  ns <- NS(id)
  tagList(
    selectInput(ns("select"),
                "Choose", 
                choices = colnames(mtcars[, -1])),
    tableOutput(ns("table"))
  )
}

moduleTable <- function(input, output, session){
  x <- reactive(select(mtcars, c(mpg, input$select)))
  output$table <- renderTable({
    x()
  })
  return(x)
}


ui <- navbarPage(position = "static-top",
                 title = "foo",
                 id = "tabs",
                 tabPanel(title = "Merge",
                          fluidRow(
                            checkboxGroupInput("to_merge",
                                               label = "Tables to merge",
                                               choices = NULL),
                            tableOutput("table")
                          )),
                 tabPanel(title = "More",
                          icon = icon("plus"),
                          fluidRow()
                 )
)

server <- function(input, output, session) {
  
  count <- reactiveValues(val=0)
  tables <- reactiveValues()
  
  dfs <- list()
  
  observeEvent(input$tabs, {
    if (input$tabs == "More"){
      count$val <- count$val+1
      name <- paste0("Name ", count$val)
      insertTab(inputId = "tabs",
                tabPanel(title = name,
                         addTab(paste0("select", count$val))
                ), 
                target = "More", 
                position = "before",
                select = TRUE)
      
      x <- callModule(moduleTable, paste0("select", count$val))
      tables[[name]] <- x
    }
  })
  
  observe({
    updateCheckboxGroupInput(session = session,
                             inputId = "to_merge",
                             choices = names(tables))
  })
  
  observe({
    req(input$to_merge)
    output$table <- renderTable({
      reduce(.x = input$to_merge, ~{tables[[.x]]()}, map2, full_join, by = "mpg")
    })
    
  })
}

shinyApp(ui = ui, server = server)

based on this answer but without success. Do you know how to do this?

Hi @bretauv. If you want to reverse the choices of input$to_merge, use rev(). And if you want to keep the selected choices, add the selected argument. For using full_join, use the following code. The answer was posted on the SO also.

library(shiny)
library(shinyWidgets)
library(tidyverse)

addTab <- function(id) {
  ns <- NS(id)
  tagList(
    selectInput(ns("select"),
                "Choose", 
                choices = colnames(mtcars[, -1])),
    tableOutput(ns("table"))
  )
}

moduleTable <- function(input, output, session){
  x <- reactive(select(mtcars, c(mpg, input$select)))
  output$table <- renderTable({
    x()
  })
  return(x)
}


ui <- navbarPage(position = "static-top",
                 title = "foo",
                 id = "tabs",
                 tabPanel(title = "Merge",
                          fluidRow(
                            checkboxGroupInput("to_merge",
                                               label = "Tables to merge",
                                               choices = NULL),
                            tableOutput("table")
                          )),
                 tabPanel(title = "More",
                          icon = icon("plus"),
                          fluidRow()
                 )
)

server <- function(input, output, session) {
  
  count <- reactiveValues(val=0)
  tables <- reactiveValues()
  
  dfs <- list()
  
  observeEvent(input$tabs, {
    if (input$tabs == "More"){
      count$val <- count$val+1
      name <- paste0("Name ", count$val)
      insertTab(inputId = "tabs",
                tabPanel(title = name,
                         addTab(paste0("select", count$val))
                ), 
                target = "More", 
                position = "before",
                select = TRUE)
      
      x <- callModule(moduleTable, paste0("select", count$val))
      tables[[name]] <- x
    }
  })
  
  observe({
    updateCheckboxGroupInput(session = session,
                             inputId = "to_merge",
                             choices = names(tables),
                             selected = input$to_merge)
  })
  
  observe({
    req(input$to_merge)
    output$table <- renderTable({
      if(!is.null(input$to_merge)) {
        tabs <- map(input$to_merge, ~{tables[[.x]]()})
        reduce(tabs, full_join)
      }
    })
  })
}

shinyApp(ui = ui, server = server)
1 Like

@raytong again, thank you

This topic was automatically closed 7 days after the last reply. New replies are no longer allowed.