rshinyshinydashboard

How to format dashboard box with vertical scroll?

For context, I am trying to convert an existing PowerBI dashboard into an RShiny dashboard with equivalent or near-equivalent functionality.

Basically, I have a horizontal bar plot with many many categories. A secondary issue is that all my bar plots in RShiny seem to be right-justified within their boxes.

I'm trying to figure out how to get the bar plot to display at full size allowing a vertical scroll, rather than having the bar plot get super tiny to fit within the static box.

I have tried fixing the box height, which I thought would automatically create a vertical scroll bar. The image

enter image description here

shows what I am trying to recreate in concept, where the bars are full-scale horizontally and the box allows for a vertical scroll. However, I keep ending up with the full plot super tiny all crammed into the box

enter image description here

and also right-justified. Below is the server and UI code for this specific plot.

library(shiny)
library(shinydashboard)
library(tidyverse)
library(plotly)

ae <- structure(list(aept = c("Upper respiratory tract infection", 
                              "Fungal infection", "COVID-19", "COVID-19", "Anxiety", "Weight increased", 
                              "Hyperlipidaemia", "Hyperglycaemia", "Influenza", "Neck pain", 
                              "Electrocardiogram QT prolonged", "Irritability", "Headache", 
                              "Contusion", "Headache", "Headache", "Headache", "Anaemia", "Candida infection", 
                              "Headache", "Headache", "Headache", "Upper respiratory tract infection", 
                              "Diarrhoea", "COVID-19", "Influenza", "Electrocardiogram T wave abnormal", 
                              "Headache", "Headache", "Headache", "Diarrhoea", "Upper respiratory tract infection", 
                              "Headache", "Vaginal infection", "Tonsillitis bacterial", "Peritonsillar abscess", 
                              "Atrioventricular block first degree", "Procedural dizziness", 
                              "Influenza", "Procedural dizziness", "Viral infection", "Diarrhoea", 
                              "Nausea", "Rhinitis", "Diarrhoea", "Upper respiratory tract infection", 
                              "Diarrhoea", "Upper respiratory tract infection", "Headache", 
                              "Rhinitis", "Upper respiratory tract infection", "Gamma-glutamyltransferase increased", 
                              "Gamma-glutamyltransferase increased", "Headache", "Headache", 
                              "Headache", "Insomnia", "", "", "Headache", "Glomerular filtration rate decreased", 
                              "Blood creatinine increased", "Headache", "Ear pain", "Headache", 
                              "Headache", "Rhinitis allergic", "Oropharyngeal pain", "Headache", 
                              "Diarrhoea", "Headache", "Headache", "Headache", "Urinary tract infection", 
                              "Headache", "Vaginal discharge", "Anaemia", "Influenza", "Bronchitis", 
                              "Upper respiratory tract infection", "Rhinitis", "Blood thyroid stimulating hormone decreased", 
                              "Abdominal pain upper", "Headache", "Tonsillitis", "Headache", 
                              "Headache", "Methaemoglobinaemia", "Abdominal pain", "Abdominal pain lower", 
                              "Blood creatine phosphokinase increased", "Electrocardiogram QT prolonged", 
                              "Headache", "Headache", "Electrocardiogram QT prolonged", "Electrocardiogram QT prolonged", 
                              "Headache", "Headache", "Upper respiratory tract infection", 
                              "Upper respiratory tract infection")), row.names = c(NA, 100L
                              ), class = "data.frame")

server <- function(input, output){
  #AE Preferred Term 
  output$ae_pt <- renderPlotly({
    p <- ae %>% group_by(aept) %>% summarise(count=n()) %>% arrange(desc(count)) %>% 
      ggplot(aes(x=reorder(aept,count), y=count)) +
      geom_bar(stat='identity') +
      coord_flip() +
      theme_minimal()
    ggplotly(p)
  })
}


ui <- dashboardPage(
  dashboardHeader(),
  dashboardSidebar(
    sidebarMenu(
      menuItem("Adverse Events", tabName = "ae", icon = icon("heart"))
    )),
  
  dashboardBody(
    tabItems(
      # Adverse Events Tab ----
      tabItem(tabName="ae",
              #AE PT and .....
              fluidRow(box(plotlyOutput("ae_pt"),title="Preferred Term"))
      )
    )))

shinyApp(ui, server)
Solution

  • Update after clarification:

    Just change to height = "1200px" :

    tabItem(tabName="ae",
              #AE PT and .....
              fluidRow(
                box(
                plotlyOutput("ae_pt", height = "1200px"),
                title = "Preferred Term",
                width = 6,
                style = "height: 1200px; overflow-y: scroll; padding-right: 10px;"
              ))
      )

    First answer:

    One way is to add style with fixed height and overflow-y: scroll
    Update your box() like this:

    
  
box(
  plotlyOutput("ae_pt", height = "800px"),
  title = "Preferred Term",
  width = 12,
  style = "height: 850px; overflow-y: scroll; padding-right: 10px;"
)

    and change output$ae_pt to

    
output$ae_pt <- renderPlotly({
  p <- ae |>
    summarise(count = n(), .by = aept) |>
    arrange(desc(count)) |>
    ggplot(aes(x = reorder(aept, count), y = count)) +
    geom_bar(stat = "identity", fill = "steelblue") +
    coord_flip() +
    theme_minimal(base_size = 14) +
    labs(x = NULL, y = "Count")
  
  ggplotly(p) |>
    layout(margin = list(l = 200))
})

    Here is the complete code:

    
library(shiny)
library(shinydashboard)
library(tidyverse)
library(plotly)

ae <- structure(list(aept = c("Upper respiratory tract infection", 
                              "Fungal infection", "COVID-19", "COVID-19", "Anxiety", "Weight increased", 
                              "Hyperlipidaemia", "Hyperglycaemia", "Influenza", "Neck pain", 
                              "Electrocardiogram QT prolonged", "Irritability", "Headache", 
                              "Contusion", "Headache", "Headache", "Headache", "Anaemia", "Candida infection", 
                              "Headache", "Headache", "Headache", "Upper respiratory tract infection", 
                              "Diarrhoea", "COVID-19", "Influenza", "Electrocardiogram T wave abnormal", 
                              "Headache", "Headache", "Headache", "Diarrhoea", "Upper respiratory tract infection", 
                              "Headache", "Vaginal infection", "Tonsillitis bacterial", "Peritonsillar abscess", 
                              "Atrioventricular block first degree", "Procedural dizziness", 
                              "Influenza", "Procedural dizziness", "Viral infection", "Diarrhoea", 
                              "Nausea", "Rhinitis", "Diarrhoea", "Upper respiratory tract infection", 
                              "Diarrhoea", "Upper respiratory tract infection", "Headache", 
                              "Rhinitis", "Upper respiratory tract infection", "Gamma-glutamyltransferase increased", 
                              "Gamma-glutamyltransferase increased", "Headache", "Headache", 
                              "Headache", "Insomnia", "", "", "Headache", "Glomerular filtration rate decreased", 
                              "Blood creatinine increased", "Headache", "Ear pain", "Headache", 
                              "Headache", "Rhinitis allergic", "Oropharyngeal pain", "Headache", 
                              "Diarrhoea", "Headache", "Headache", "Headache", "Urinary tract infection", 
                              "Headache", "Vaginal discharge", "Anaemia", "Influenza", "Bronchitis", 
                              "Upper respiratory tract infection", "Rhinitis", "Blood thyroid stimulating hormone decreased", 
                              "Abdominal pain upper", "Headache", "Tonsillitis", "Headache", 
                              "Headache", "Methaemoglobinaemia", "Abdominal pain", "Abdominal pain lower", 
                              "Blood creatine phosphokinase increased", "Electrocardiogram QT prolonged", 
                              "Headache", "Headache", "Electrocardiogram QT prolonged", "Electrocardiogram QT prolonged", 
                              "Headache", "Headache", "Upper respiratory tract infection", 
                              "Upper respiratory tract infection")), row.names = c(NA, 100L
                              ), class = "data.frame")

server <- function(input, output){
  #AE Preferred Term 
  output$ae_pt <- renderPlotly({
    p <- ae |>
      summarise(count = n(), .by = aept) |>
      arrange(desc(count)) |>
      ggplot(aes(x = reorder(aept, count), y = count)) +
      geom_bar(stat = "identity", fill = "steelblue") +
      coord_flip() +
      theme_minimal(base_size = 14) +
      labs(x = NULL, y = "Count")
    
    ggplotly(p) |>
      layout(margin = list(l = 200))
  })
  
}


ui <- dashboardPage(
  dashboardHeader(),
  dashboardSidebar(
    sidebarMenu(
      menuItem("Adverse Events", tabName = "ae", icon = icon("heart"))
    )),
  
  dashboardBody(
    tabItems(
      # Adverse Events Tab ----
      tabItem(tabName="ae",
              #AE PT and .....
              fluidRow(
                box(
                plotlyOutput("ae_pt", height = "800px"),
                title = "Preferred Term",
                width = 12,
                style = "height: 850px; overflow-y: scroll; padding-right: 10px;"
              ))
      )
    )))

shinyApp(ui, server)

    enter image description here