Shiny dashboard - separate tab items and custom color for the scatterplot

R code
1

Hi,

I have been working on a simple dashboard of a correlation plot with data table.

First, I would like to change the colors of the plot but my codes aren’t working.
Second, the correlation plot should be separate from the data table (two menu items) but my codes resulted to two menus bearing both the plot and data table.

I hope you could again guide me and would highly appreciate if you have further suggestions in my codes for this simple dashboard.

Thank you very much and Happy Holidays.

Respectfully,
Echo

pacman:: p_load(
  rio,
  here,
  janitor,
  lubridate,
  tidyverse,
  ISOweek,
  ggplot2,
  data.table,
  naniar,
  hrbrthemes,
  zoo,
  grid
)

#Dataset
icu <- import(here("data", "hcu10Dec2023.xlsx")) %>% #use final icu data from stata then export as excel
  filter(Regname=="TOTAL") %>% 
  select(IcuO, Date, total_covid_cases, total_severe_critical) %>% 
  group_by(Date, total_covid_cases, total_severe_critical) %>%
  summarise(n = sum(IcuO)) %>% 
  rename(IcuO = n) %>% 
  rename("COVID-19 Cases" = total_covid_cases) %>% 
  rename("Severe and Critical Cases" = total_severe_critical)  

library(shiny)
library(shinydashboard)

ui <- 
  dashboardPage(skin = "red",   
    dashboardHeader(title = "ICU dashboard"),
    dashboardSidebar(
      sidebarMenu(
        menuItem("ICU", tabName = "icu", icon = icon("bed")),
        menuItem("ICU table", tabName = "icu2", icon = icon("table"))
      ))
      ,
    dashboardBody(
      tabItems(
        tabItem("icu",
                box(plotOutput("correlation_plot"),  
                    width = 8, colors = c("blue", "red")),          
                box(
                  selectInput("parameters", "Parameters:",              
                              c("COVID-19 Cases", "Severe and Critical Cases")), 
                  width = 4
                ),
                tabItem("icu2",
                        fluidPage(
                          dataTableOutput("icutable")
                        ))
        ))))
      


server <-  function(input, output){
  output$correlation_plot <- renderPlot({
    plot(icu$IcuO, icu[[input$parameters]],
         xlab = "No.of icu beds occupied", ylab = "Number")
  })
  
  output$icutable <- renderDataTable(icu)
}
shinyApp(ui, server)
2 Likes
2

Hello @Echo_Bajador , can you provide a sample of your “icu” object?

1 Like
3

Here it is:

 dput(head(icu))
structure(list(Date = structure(c(1672531200, 1672617600, 1672704000, 
1672790400, 1672876800, 1672963200), tzone = "UTC", class = c("POSIXct", 
"POSIXt")), `COVID-19 Cases` = c(875, 940, 993, 1037, 1030, 1056
), `Severe and Critical Cases` = c(158, 172, 169, 167, 168, 179
), IcuO = c(351, 437, 414, 461, 443, 457)), class = c("grouped_df", 
"tbl_df", "tbl", "data.frame"), row.names = c(NA, -6L), groups = structure(list(
    Date = structure(c(1672531200, 1672617600, 1672704000, 1672790400, 
    1672876800, 1672963200), tzone = "UTC", class = c("POSIXct", 
    "POSIXt")), `COVID-19 Cases` = c(875, 940, 993, 1037, 1030, 
    1056), .rows = structure(list(1L, 2L, 3L, 4L, 5L, 6L), ptype = integer(0), class = c("vctrs_list_of", 
    "vctrs_vctr", "list"))), class = c("tbl_df", "tbl", "data.frame"
), row.names = c(NA, -6L), .drop = TRUE))
#>         Date COVID-19 Cases Severe and Critical Cases IcuO
#> 1 2023-01-01            875                       158  351
#> 2 2023-01-02            940                       172  437
#> 3 2023-01-03            993                       169  414
#> 4 2023-01-04           1037                       167  461
#> 5 2023-01-05           1030                       168  443
#> 6 2023-01-06           1056                       179  457

Thanks.

2 Likes
4

Thanks!

The issue with the menu items arises from the incorrect placement of the tabItem("icu2", ...) function. In a Shiny dashboard, each call to tabItem should be a direct argument of tabItems to define separate tabs. The corrected structure ensures that both “icu” and “icu2” tabs are defined independently.

Regarding the color problem, when using R base plot function, the col argument needs to be specified to set the color. In this case, we added col = "green" inside the plot function.

Here’s your modified ui and server .

ui <- 
  dashboardPage(skin = "red",   
                dashboardHeader(title = "ICU dashboard"),
                dashboardSidebar(
                  sidebarMenu(
                    menuItem("ICU", tabName = "icu", icon = icon("bed")),
                    menuItem("ICU table", tabName = "icu2", icon = icon("table"))
                  )
                ),
                dashboardBody(
                  tabItems(
                    tabItem("icu",
                            fluidRow(
                              box(plotOutput("correlation_plot"), width = 8, color = "green"),          
                              box(
                                selectInput("parameters", "Parameters:", c("COVID-19 Cases", "Severe and Critical Cases")), 
                                width = 4
                              )
                            )
                    ),
                    tabItem("icu2",
                            fluidRow(
                              box(
                                dataTableOutput("icutable")
                              )
                            )
                    )
                  )
                )
  )

server <-  function(input, output){
  output$correlation_plot <- renderPlot({
    plot(icu$IcuO, icu[[input$parameters]],
         xlab = "No.of icu beds occupied", ylab = "Number", col = "green")
  })
  
  output$icutable <- renderDataTable(icu)
}

Let me know if helped you.

Lucca

1 Like
5

Oh, and it should also be fluidRow and not fluidPage.
It worked. Awesome.
Thank you so much for the time, always.

Echo

2 Likes
6

fluidRow is great for organizing elements in a row, simple and precise. Sometimes, when you need a more comprehensive page layout, fluidPage is the way to go. Check Chapter 6 Layout, themes, HTML | Mastering Shiny for more info.

Cheers,
Lucca

2 Likes
7

Great.
Highly appreciate it.

1 Like