TabPanel中的R Shiny Scrollable表列表

Question

如何在tabPanel中创建可滚动的表列表？

基于Outputing N tables in shiny, where N depends on the data，我尝试了以下

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")
    )
 )

当列表变长时会显示一个主要的firefox滚动条，但是有一个不垂直滚动的表的第二个滚动条。理想情况下，我也会消除水平滚动。

Answer 1

您需要先调用render来创建输出对象，然后用这些对象组合UI：

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)

基于Winston Chang的工作here

Answer 2

我将列表包裹在fluidPage或wellPanel中，一切正常。

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")
     )
 )