Step Up Your Dashboard With Shinydashboard – Part 2: Solutions

# load packages
library(shiny)
library(shinydashboard)

##################################
#                                #
#    Basic Code to Start With    #
#                                #
##################################
header <- dashboardHeader(
  title = span(
    "Practicing shinydashboard",
    style = "font-family: Tahoma; font-weight: bold"
  ),
  titleWidth = "300px"
)

sidebar <- dashboardSidebar(
  width = "300px",
  sidebarMenu(
    sidebarSearchForm(
      textId = "search_text",
      buttonId = "search_button",
      label = "What are you looking for?"
    ),
    selectInput(
      inputId = "plant",
      label = "Select Plant",
      choices = unique(CO2$Plant)
    ),
    menuItem(
      text = span("Data", style = "font-size: 20px"),
      tabName = "data",
      icon = icon("database"),
      badgeLabel = "New",
      badgeColor = "yellow"
    ),
    menuItem(
      text = span("About", style = "font-size: 20px"),
      tabName = "about",
      icon = icon("info-circle"),
      menuSubItem(text = "Licenses", tabName = "licenses"),
      menuSubItem(text = "Contact Us", tabName = "contact_us")
    )
  )
)

body <- dashboardBody()

ui <- dashboardPage(
  skin = "black",
  title = "R-Exercises",
  header = header,
  sidebar = sidebar,
  body = body
)

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

shinyApp(ui = ui, server = server)

####################
#                  #
#    Exercise 1    #
#                  #
####################
body <- dashboardBody(
  tabItems(
    tabItem(
      tabName = "data",
      box(
        title = "CO2 Data",
        status = "primary",
        collapsible = T
      )
    )
  )
)

####################
#                  #
#    Exercise 2    #
#                  #
####################   
body <- dashboardBody(
  tabItems(
    tabItem(
      tabName = "data",
      box(
        title = "CO2 Data",
        status = "primary",
        collapsible = T,
        tableOutput(outputId = "co2_table")
      )
    )
  )
)

server <- function(input, output, session) {
  output$co2_table <- renderTable(CO2[CO2$Plant == input$plant, ])
}

####################
#                  #
#    Exercise 3    #
#                  #
####################
body <- dashboardBody(
  tabItems(
    tabItem(
      tabName = "data",
      box(
        title = "CO2 Data",
        status = "primary",
        collapsible = T,
        tableOutput(outputId = "co2_table")
      )
    ),
    tabItem(
      tabName = "licenses",
      tabBox(
        tabPanel(title = "Data", "Data licenses..."),
        tabPanel(title = "Icons", "Icons licenses...")
      )
    )
  )
)

####################
#                  #
#    Exercise 4    #
#                  #
####################
body <- dashboardBody(
  tabItems(
    tabItem(
      tabName = "data",
      box(
        title = "CO2 Data",
        status = "primary",
        collapsible = T,
        tableOutput(outputId = "co2_table")
      )
    ),
    tabItem(
      tabName = "licenses",
      tabBox(
        tabPanel(title = "Data", "Data licenses..."),
        tabPanel(title = "Icons", "Icons licenses...")
      )
    ),
    tabItem(
      tabName = "contact_us",
      fluidRow(
        infoBox(
          title = "Email",
          value = "shiny@dashboard.com",
          subtitle = "(2-3 days to answer)",
          icon = icon("envelope"),
          color = "purple"
        )
      )
    )
  )
)

####################
#                  #
#    Exercise 5    #
#                  #
####################
body <- dashboardBody(
  tabItems(
    tabItem(
      tabName = "data",
      box(
        title = "CO2 Data",
        status = "primary",
        collapsible = T,
        tableOutput(outputId = "co2_table")
      )
    ),
    tabItem(
      tabName = "licenses",
      tabBox(
        tabPanel(title = "Data", "Data licenses..."),
        tabPanel(title = "Icons", "Icons licenses...")
      )
    ),
    tabItem(
      tabName = "contact_us",
      fluidRow(
        infoBox(
          title = "Email",
          value = "shiny@dashboard.com",
          subtitle = "(2-3 days to answer)",
          icon = icon("envelope"),
          color = "purple"
        )
      ),
      fluidRow(
        valueBox(
          value = 2,
          subtitle = "Average response time (days)",
          icon = icon("thumbs-up"),
          color = "green"
        )
      )
    )
  )
)

####################
#                  #
#    Exercise 6    #
#                  #
####################
header <- dashboardHeader(
  title = span(
    "Practicing shinydashboard",
    style = "font-family: Tahoma; font-weight: bold"
  ),
  titleWidth = "300px",
  dropdownMenu(
    type = "messages",
    badgeStatus = "primary",
    icon = icon("comments"),
    messageItem(from = "Admin", message = "Welcome to my dashboard!")
  )
)

####################
#                  #
#    Exercise 7    #
#                  #
####################
header <- dashboardHeader(
  title = span(
    "Practicing shinydashboard",
    style = "font-family: Tahoma; font-weight: bold"
  ),
  titleWidth = "300px",
  dropdownMenu(
    type = "messages",
    badgeStatus = "primary",
    icon = icon("comments"),
    messageItem(from = "Admin", message = "Welcome to my dashboard!")
  ),
  dropdownMenu(
    type = "tasks",
    badgeStatus = "success",
    icon = icon("check-square"),
    taskItem(text = "Complete the dashboard", value = 81, color = "green"),
    taskItem(text = "Fix bugs", value = 45, color = "yellow")
  )
)

####################
#                  #
#    Exercise 8    #
#                  #
####################
header <- dashboardHeader(
  title = span(
    "Practicing shinydashboard",
    style = "font-family: Tahoma; font-weight: bold"
  ),
  titleWidth = "300px",
  dropdownMenu(
    type = "messages",
    badgeStatus = "primary",
    icon = icon("comments"),
    messageItem(from = "Admin", message = "Welcome to my dashboard!")
  ),
  dropdownMenu(
    type = "tasks",
    badgeStatus = "success",
    icon = icon("check-square"),
    taskItem(text = "Complete the dashboard", value = 81, color = "green"),
    taskItem(text = "Fix bugs", value = 45, color = "yellow")
  ),
  dropdownMenuOutput(outputId = "notifications")
)

####################
#                  #
#    Exercise 9    #
#                  #
####################
server <- function(input, output, session) {
  output$co2_table <- renderTable(CO2[CO2$Plant == input$plant, ])

  output$notifications <- renderMenu(
    dropdownMenu(
      type = "notifications",
      badgeStatus = "warning",
      icon = icon("exclamation-circle"),
      notificationItem(
        text = paste("You have selected", input$plant),
        status = "warning"
      )
    )
  )
}

####################
#                  #
#    Exercise 10   #
#                  #
####################
header <- dashboardHeader(
  title = span(
    "Practicing shinydashboard",
    style = "font-family: Tahoma; font-weight: bold"
  ),
  titleWidth = "300px",
  tags$li(
    class = "dropdown",
    tags$a(
      "Go to R-exercises",
      href = "https://r-exercises.com",
      target = "_blank"
    )
  ),
  dropdownMenu(
    type = "messages",
    badgeStatus = "primary",
    icon = icon("comments"),
    messageItem(from = "Admin", message = "Welcome to my dashboard!")
  ),
  dropdownMenu(
    type = "tasks",
    badgeStatus = "success",
    icon = icon("check-square"),
    taskItem(text = "Complete the dashboard", value = 81, color = "green"),
    taskItem(text = "Fix bugs", value = 45, color = "yellow")
  ),
  dropdownMenuOutput(outputId = "notifications")
)

################################
#                              #
#    All Exercises Combined    #
#                              #
################################
header <- dashboardHeader(
  title = span(
    "Practicing shinydashboard",
    style = "font-family: Tahoma; font-weight: bold"
  ),
  titleWidth = "300px",
  # exercise 10
  tags$li(
    class = "dropdown",
    tags$a(
      "Go to R-exercises",
      href = "https://r-exercises.com",
      target = "_blank"
    )
  ),
  # exercise 6
  dropdownMenu(
    type = "messages",
    badgeStatus = "primary",
    icon = icon("comments"),
    messageItem(from = "Admin", message = "Welcome to my dashboard!")
  ),
  # exercise 7
  dropdownMenu(
    type = "tasks",
    badgeStatus = "success",
    icon = icon("check-square"),
    taskItem(text = "Complete the dashboard", value = 81, color = "green"),
    taskItem(text = "Fix bugs", value = 45, color = "yellow")
  ),
  # exercise 8
  dropdownMenuOutput(outputId = "notifications")
)

sidebar <- dashboardSidebar(
  width = "300px",
  sidebarMenu(
    sidebarSearchForm(
      textId = "search_text",
      buttonId = "search_button",
      label = "What are you looking for?"
    ),
    selectInput(
      inputId = "plant",
      label = "Select Plant",
      choices = unique(CO2$Plant)
    ),
    menuItem(
      text = span("Data", style = "font-size: 20px"),
      tabName = "data",
      icon = icon("database"),
      badgeLabel = "New",
      badgeColor = "yellow"
    ),
    menuItem(
      text = span("About", style = "font-size: 20px"),
      tabName = "about",
      icon = icon("info-circle"),
      menuSubItem(text = "Licenses", tabName = "licenses"),
      menuSubItem(text = "Contact Us", tabName = "contact_us")
    )
  )
)

body <- dashboardBody(
  tabItems(
    tabItem(
      tabName = "data",
      # exercise 1
      box(
        title = "CO2 Data",
        status = "primary",
        collapsible = T,
        tableOutput(outputId = "co2_table") # exercise 2
      )
    ),
    tabItem(
      tabName = "licenses",
      # exercise 3
      tabBox(
        tabPanel(title = "Data", "Data licenses..."),
        tabPanel(title = "Icons", "Icons licenses...")
      )
    ),
    tabItem(
      tabName = "contact_us",
      fluidRow(
        # exercise 4
        infoBox(
          title = "Email",
          value = "shiny@dashboard.com",
          subtitle = "(2-3 days to answer)",
          icon = icon("envelope"),
          color = "purple"
        )
      ),
      fluidRow(
        # exercise 5
        valueBox(
          value = 2,
          subtitle = "Average response time (days)",
          icon = icon("thumbs-up"),
          color = "green"
        )
      )
    )
  )
)

ui <- dashboardPage(
  skin = "black",
  title = "R-Exercises",
  header = header,
  sidebar = sidebar,
  body = body
)

server <- function(input, output, session) {
  # exercise 2
  output$co2_table <- renderTable(CO2[CO2$Plant == input$plant, ])

  # exercise 9
  output$notifications <- renderMenu(
    dropdownMenu(
      type = "notifications",
      badgeStatus = "warning",
      icon = icon("exclamation-circle"),
      notificationItem(
        text = paste("You have selected", input$plant),
        status = "warning"
      )
    )
  )
}

shinyApp(ui = ui, server = server)