使用 gtoutput 在 R 中的 Shiny 应用程序中显示多个表

Displaying multiple tables in Shiny app in R with gtoutput

这是我的 R Shiny 代码。

如您所见,每个组(“A”和“B”)都有多个表。我怎样才能用 shiny 显示与每个组相关的所有表?

我尝试使用地图,但它不起作用。

有什么帮助吗?

library(shiny)

lista <- as.list(1:12)

tables_shiny<- mtcars %>%
                  rownames_to_column() %>%
                    slice(1:5) %>%
                      pivot_longer(cols = mpg:last_col()) %>%
                        mutate(groups = c(rep("A",27),rep("B",28)), .before = everything())

groups <- tables_shiny$groups %>% unique()
choices <- tables_shiny$rowname %>% unique()


ui <- fluidPage(

    # Application title
    titlePanel("Old Faithful Geyser Data"),

    # Sidebar with a slider input for number of bins
    sidebarLayout(
        sidebarPanel(
          radioButtons(
            "groups",
            label = "Groups",
            choices = groups,
            selected =  groups[1]
          )

        ),


        mainPanel(
            gt_output("tables_1")
        )
    )
)

# Define server logic required to draw a histogram
server <- function(input, output) {

  groups_reactive<- reactive({input$groups})


output$tables_1 <- render_gt({
                      tables_shiny %>%
                          filter(groups == groups_reactive()) %>%
                            group_split(rowname) %>%
                              map(~ .x %>% gt() %>% tab_header(title = groups_reactive()))


  })



}

# Run the application
shinyApp(ui = ui, server = server)

每个输出只能渲染一个 table UI,因此您必须动态添加它们:

library(tidyverse)
library(shiny)
library(gt)

lista <- as.list(1:12)

tables_shiny <-
  mtcars %>%
  rownames_to_column() %>%
  slice(1:5) %>%
  pivot_longer(cols = mpg:last_col()) %>%
  mutate(groups = c(rep("A", 27), rep("B", 28)), .before = everything())

groups <- tables_shiny$groups %>% unique()
choices <- tables_shiny$rowname %>% unique()


ui <- fluidPage(

  # Application title
  titlePanel("Old Faithful Geyser Data"),

  # Sidebar with a slider input for number of bins
  sidebarLayout(
    sidebarPanel(
      radioButtons(
        "groups",
        label = "Groups",
        choices = groups,
        selected =  groups[1]
      )
    ),
    mainPanel(
      uiOutput("tables")
    )
  )
)

# Define server logic required to draw a histogram
server <- function(input, output) {
  observeEvent(
    eventExpr = input$groups,
    handlerExpr = {
      message("foo")

      tables_shiny$rowname %>%
        unique() %>%
        walk(~ {
          insertUI(selector = "#tables", ui = gt_output(outputId = .x))

          output[[.x]] <-
            tables_shiny %>%
            filter(groups == input$groups & rowname == .x) %>%
            gt() %>%
            tab_header(title = .x) %>%
            render_gt()
        })
    }
  )
}

# Run the application
shinyApp(ui = ui, server = server)