CODEWITHSUNDEEP
rshinyshinydashboard
GGG
GGG

Reputation: 33

shiny: better way to create tables in loop across tab panels

I have to create a Shiny/ShinyDashboard app which basically creates a bunch of tables for various teams. Users will select their team from the sidebar and then they will have several tab panels to choose from depending on the data. See here:

shinyapp

Now the requirement is that I have to split the data for each tab panel into distinct datatables and -because of the data- I have to generate this dynamically.

I came up with the following code (reprex down here) but since I'm quite new to Shiny, I wondered if:

library(shiny)
library(shinydashboard)
library(datasets)
library(dplyr)
library(DT)

cars <- mtcars
irises <- iris
cars$team <- sample(c("Team1", "Team2"), nrow(cars), replace = TRUE)
irises$team <-
  sample(c("Team1", "Team2"), nrow(irises), replace = TRUE)

# UI
ui <- dashboardPage(
  dashboardHeader(title = "Teams"),
  dashboardSidebar(sidebarMenu(
    menuItem("Team 1",
             tabName = "tab_team1",
             icon = icon("dashboard")),
    menuItem("Team 2",
             tabName = "tab_team2",
             icon = icon("dashboard"))
  )),
  dashboardBody(tabItems(
    tabItem(tabName = "tab_team1",
            fluidRow(
              tabBox(
                title = "",
                width = "100%",
                tabPanel(title = "A",
                         uiOutput("Team1_content_A")),
                tabPanel(title = "B",
                         uiOutput("Team1_content_B"))
              )
            )),
    tabItem(tabName = "tab_team2",
            fluidRow(
              tabBox(
                title = "",
                width = "100%",
                tabPanel(title = "A",
                         uiOutput("Team2_content_A")),
                tabPanel(title = "B",
                         uiOutput("Team2_content_B"))
              )
            ))
  ))
)



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

  lapply(1:2, function(i) {
    t <- paste0("Team", i)
    
    table <- cars %>%
      filter(team == t)
    
    output[[paste0(t, "_content_A")]] <- renderUI({
      lapply(sort(unique(table$gear)), function(i) {
        id <- paste0(t, "_content_A_", i)
        
        output[[id]] <-
          DT::renderDataTable(datatable(table[table$gear == i, ]))
        
        fluidRow(
          box(
            width = "100%",
            title = paste0("Gears: ", i),
            status = "info",
            solidHeader = TRUE,
            collapsible = TRUE,
            DT::dataTableOutput(id)
          )
        )
      })
    })
    
    table2 <- irises %>%
      filter(team == t)
    
    output[[paste0(t, "_content_B")]] <- renderUI({
      lapply(sort(unique(table2$Species)), function(i) {
        id <- paste0(t, "_content_B_", i)
        
        output[[id]] <-
          DT::renderDataTable(datatable(table2[table2$Species == i, ]))
        
        fluidRow(
          box(
            width = "100%",
            title = paste0("Species: ", i),
            status = "info",
            solidHeader = TRUE,
            collapsible = TRUE,
            DT::dataTableOutput(id)
          )
        )
      })
    })
  })
}
shinyApp(ui, server)

Upvotes: 0

Views: 883

Answers (1)

Xiang
Xiang

Reputation: 314

Echo to @Limey, I would also suggest to use shiny modules https://mastering-shiny.org/scaling-modules.html. There are two reasons.

  1. Reduce unnecessary computation. Currently the computation is run for all the four panels (team1_tabA, team1_tabB, team2_tabA, team2_tabB) at the same time. Ideally, as you add more features or data in the future, you would want to only run the necessary computation when certain action is performed. (i.e. when user click team1_tabA, only the required tables is calculated, no need to calculate tables for other tabs.). Modules can help achieve it.
  1. More flexible control over UI and Server. Currently your app has the same server function and outputs for all the four panels, it works for now. But if in the future you want the four panels to have different layout and outputs, the current coding style might prompt you to write more complex and repeated code. And modules can help you get rid of the repeat and help with more flexible control over the UI and server.

Here is a modularized version of your shiny app. I encountered some issues with using namespace (NS(id)) in the dynamic UI (renderUI), and thanks to the feedback from @YBS Why the shiny dynamic UI + modules does not give the desired output?, the problem is solved, and the modularized shiny is able to run.

## module UI
tab_ui <- function(id) {
  ns <- NS(id) ## namespace function
  uiOutput(ns("content"))
}

## module Server
tab_server <- function(id, data, Team, var) {
  moduleServer(id, function(input, output, session) {
    ns <- session$ns ## call namespace in the server

    table <- reactive({
      data %>% filter(team == Team)
    })

    output$content <- renderUI({
      lapply(sort(unique(table()[[var]])), function(i) {
        idd <- paste0("content_", i)

        output[[idd]] <-
          DT::renderDataTable(datatable(table()[table()[[var]] == i, ]))

        fluidRow(
          box(
            width = "100%",
            title = paste0(var, " ", i),
            status = "info",
            solidHeader = TRUE,
            collapsible = TRUE,
            DT::dataTableOutput(ns(idd)) ## !!! need to use namespace
          )
        )
      })
    })
  })
}

## library
library(shiny)
library(shinydashboard)
library(datasets)
library(dplyr)
library(DT)

## data
cars <- mtcars
irises <- iris
cars$team <- sample(c("Team1", "Team2"), nrow(cars), replace = TRUE)
irises$team <-
  sample(c("Team1", "Team2"), nrow(irises), replace = TRUE)


## UI
ui <- dashboardPage(
  dashboardHeader(title = "Teams"),
  dashboardSidebar(sidebarMenu(
    menuItem("Team 1",
      tabName = "tab_team1"
    ),
    menuItem("Team 2",
      tabName = "tab_team2"
    )
  )),
  dashboardBody(tabItems(
    tabItem(
      tabName = "tab_team1",
      fluidRow(
        tabBox(
          title = "",
          width = "100%",
          tabPanel(
            title = "A",
            tab_ui("team1_tabA") ## module ui
          ), 
          tabPanel(
            title = "B",
            tab_ui("team1_tabB") ## module ui
          ) 
        )
      )
    ),
    tabItem(
      tabName = "tab_team2",
      fluidRow(
        tabBox(
          title = "",
          width = "100%",
          tabPanel(
            title = "A",
            tab_ui("team2_tabA") ## module ui
          ), 
          tabPanel(
            title = "B",
            tab_ui("team2_tabB") ## module ui
          ) 
        )
      )
    )
  ))
)

## server
server <- function(input, output, session) {

  # module server
  tab_server("team1_tabA", data = cars, Team = "Team1", var = "gear")
  tab_server("team1_tabB", data = irises, Team = "Team1", var = "Species")
  tab_server("team2_tabA", data = cars, Team = "Team2", var = "gear")
  tab_server("team2_tabB", data = irises, Team = "Team2", var = "Species")
}

shinyApp(ui, server)

Upvotes: 1

Related Questions