R Shiny Scrollable List of Tables in TabPanel

Question

How do I create a scrollable list of tables within a tabPanel?

Based on Outputing N tables in shiny, where N depends on the data, I have tried the following

Server.R

userHist <- list(
    data.frame(X=1:10,Y=11:20),
    data.frame(X=1:10,Y=11:20))

output$groupHistory <- renderUI({
    userHistList <- lapply( seq(userHist), function(i){
        hist_i  <- userHist[[i]]
        TabName <- paste0("User", i)

        fluidRow( column(10,
            h2(TabName),
            hr(),
            column(3, renderTable(hist_i, rownames=TRUE) )
        ) )
    } )
    userHistList
})

ui.R

tabsetPanel(id="tabsetpanel",
    tabPanel(h1("Group History"),
        style="overflow-y:scroll;",
        uiOutput("groupHistory")
    )
 )

There is a main firefox scrollbar that shows up when the list gets long, but there is a second scrollbar for the table that does not scroll vertically. Ideally I would also eliminate horizontal scrolling.

Answer 1

You need to call the render first to create the output objects and the compose the UI with those objects:

ui <- fluidPage(
  tabsetPanel(
    id = "tabsetpanel",
    tabPanel(
      style = "overflow-y:scroll; max-height: 600px",
      h1("Group History"),
      numericInput("n_users", "Number of Users", value = 5, min = 1, max = 10),
      uiOutput("group_history")
    )
  )
)

server <- shinyServer(function(input, output) {

  df_list <- reactive({
    n <- input$n_users

    # generate some observations
    obs_x <- seq(3)
    obs_y <- obs_x + n

    # generate the df
    df_template <- data.frame(x = obs_x, y = obs_y)

    # make a list of df and return
    lapply(seq(n), function(n) {
      df_template
    })
  })

  # use the constructed renders and compose the ui
  output$group_history <- renderUI({
    table_output_list <- lapply(seq(input$n_users), function(i) {
      table_name <- paste0("table", i)
      tab_name   <- paste("User", i)

       fluidRow(
        column(
          width = 10,
          h2(tab_name), 
          hr(), column(3, tableOutput(table_name))
        )
      )
    })

    # Convert the list to a tagList - this is necessary for the list of items
    # to display properly.
    do.call(tagList, table_output_list)
  })

  # Call renderTable for each one. Tables are only actually generated when they
  # are visible on the web page.
  observe({

    data <- df_list()

    for (i in seq(input$n_users)) {
      # Need local so that each item gets its own number. Without it, the value
      # of i in the renderPlot() will be the same across all instances, because
      # of when the expression is evaluated.
      local({
        my_i               <- i 
        tab_name           <- paste0("table", my_i)
        output[[tab_name]] <- renderTable(data[[my_i]], rownames = TRUE)
      })
    }
  })

})

shinyApp(ui, server)

Based off of Winston Chang's work here

Answer 2

I wrapped the list in fluidPage or wellPanel and everything works as I want.

Server.R

userHist <- list(
    data.frame(X=1:10,Y=11:20),
    data.frame(X=1:10,Y=11:20))

output$groupHistory <- renderUI({

    userHistList <- lapply( seq(userHist), function(i){
        hist_i  <- userHist[[i]]
        TabName <- paste0("User", i)

        fluidRow( column(10,
            h2(TabName),
            hr(),
            column(3, renderTable(hist_i, rownames=TRUE) )
        ) )
    } )
    table_output_list <- fluidPage(userHistList,
        style="overflow-y:scroll; max-height: 90vh")

})

UI.R

tabsetPanel(id="tabsetpanel",
    tabPanel(h1("Group History"),
        style="overflow: visible",
        uiOutput("groupHistory")
     )
 )