rshinydashboard

Shiny Dashboard Reactive Content Issue


I am trying to teach myself how to build a Shiny Dashboard and am experimenting with reactive content, and I am definitely over my head. I have simplified my data and dashboard for this post.

My sidebar menu items are currently the following, but will vary based upon the data file that the script reads:

The "General" and "Detailed Analysis" sidebar items are static. The others are determined dynamically based upon a data file that is read in. I read the data file into a data frame, and then see which Departments there are data for and generate the side bar menu. The issue that I am having is when I want to put more than one plot / table etc on one of the content pages. I only seem to get the last item that I try to display.

My data looks like this:

Department,FY
Engineering,20
Engineering,24
Engineering,21
Engineering,22
Engineering,23
Engineering,20
Engineering,24
Engineering,22
Analysis,22
Analysis,24
Analysis,20
Analysis,19
Analysis,23

As I said, I have simplified the code, so my outputs don't really make sense. I am just trying to figure out how to render 2 items on the same page. In particular, I am trying to render 2 value boxes in the else statement and I only get the second one.

Here is my code:

options(shiny.maxRequestSize = 200*1024^2)

wd <<- choose.dir(caption = "Select top level folder where your data is located")
setwd(wd)

# Read in data
data_df <- read.csv("Work_By_Department.csv")

start_list <- list("General")
end_list <- list("Detailed Analysis")

menu_list <- str_to_title(unique(data_df$Department))
final_menu_list <- c(start_list, menu_list, end_list)

num_items <- length(final_menu_list)
 
print(num_items)

labels = do.call(rbind, Map(data.frame, id = num_items, name = final_menu_list))
labels$tabname <- gsub(" ", "-", labels$name)

ui <- dashboardPage(
  dashboardHeader(title = "Results Dashboard"),
  dashboardSidebar(
    uiOutput("sidebar_menu_UI")
  ),
  
  dashboardBody(
    uiOutput("tabItms")
  ) #dashboardbody
) #dashboardpage

server <- function(input, output, session) {
  
  output$sidebar_menu_UI <- renderUI({
    mytabs <- lapply(1:nrow(labels), function(i) {
      # tabName must correspond to a tabItem tabName
      menuItem(labels$name[i], tabName = labels$tabname[i])
    })
    do.call(function(...) sidebarMenu(id = "mytabs", ...), mytabs)
  })
  
  output$tabItms <- renderUI({
    
    itemsDyn <- lapply(menu_list, function(name) {
      content <- fluidRow(
        h1(
          name,
          style = "font-size:28px; font-family: arial, calibri, sans-serif; text-align: center; margin-left: 15px; margin-top: 5px; text-decoration: underline;"
        ),
        
          if (name == "Engineering") {
            valueBox(
              num_items,
              sprintf("Total Number of %s Efforts", name),
              icon = icon("layer-group", lib="font-awesome"), 
              width = 4
            )
            
          } else {
            valueBox(
              num_items,
              sprintf("Total Number of %s Efforts", name),
              icon = icon("layer-group", lib="font-awesome"), 
              width = 4
            )
            valueBox(
              num_items + 5,
              sprintf("Total Number of %s Efforts", name),
              icon = icon("layer-group", lib="font-awesome"), 
              width = 4
            )
          })

      tabItem(tabName = name, content)
    })
    
    items <- c(
      list(
        tabItem(
          "General",
          fluidRow(
            h1(
              "General Information", 
              style = "font-size:28px; font-family: arial, calibri, sans-serif; text-align: center; margin-left: 15px; margin-top: 5px; text-decoration: underline"
            ),
            valueBox(
              num_reps, 
              "Total Number of Departments", 
              icon = icon("layer-group", lib = "font-awesome"), 
              width = 4
            )
          )
        )
      ),  
      itemsDyn,
      list(
        tabItem(
          tabName = "Detailed-Analysis",
          fluidRow(
            h1(
              "Detailed Analysis", 
              style = "font-size:28px; font-family: arial, calibri, sans-serif; text-align: center; margin-left: 15px; margin-top: 5px; text-decoration: underline"
            ),
            box(
              title = "Statistics", status = "success", solidHeader = TRUE,
              collapsible = TRUE,
              div(
                "Work Efforts by Department", 
                style = "font-size: 15px; font-family: arial, calibri; text-align: center; font-weight: bold"
              ),
              tags$br(),
              align = "center",
              tableOutput("detailsTable")
            )
          )
        )
      )
    )
    do.call(tabItems, items)
  })
  
  output$detailsTable <- renderTable(
    data_df, bordered = TRUE, digits = 1, striped = TRUE
  )
}

# Run the app ----
shinyApp(ui, server)

I would greatly appreciate any help. Thanks!


Solution

  • Using tagList is a possible way:

    content <- fluidRow(
      h1(
        name,
        style = "font-size:28px; font-family: arial, calibri, sans-serif; text-align: center; margin-left: 15px; margin-top: 5px; text-decoration: underline;"
      ),
      
      if (name == "Engineering") {
        valueBox(
          num_items,
          sprintf("Total Number of %s Efforts", name),
          icon = icon("layer-group", lib="font-awesome"), 
          width = 4
        )
        
      } else {
        tagList(
          valueBox(
            num_items,
            sprintf("Total Number of %s Efforts", name),
            icon = icon("layer-group", lib="font-awesome"), 
            width = 4
          ),
          valueBox(
            num_items + 5,
            sprintf("Total Number of %s Efforts", name),
            icon = icon("layer-group", lib="font-awesome"), 
            width = 4
          )
        )
      }
      
    )