Home > OS >  Displaying multiple tables in Shiny app in R with gtoutput
Displaying multiple tables in Shiny app in R with gtoutput

Time:02-23

this is my R Shiny code.

As you can see every group ("A" and "B") have multiple tables. How can I display all the tables related to each grou with shiny?

I tried to use map but its not working.

Any help?

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)

CodePudding user response:

You can only render one table per output UI, so you have to dynamically add them:

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)
  • Related