Reactive Bar Chart in Shiny with gather

Question

I am trying to add a barchart to my dashboard in Shiny but I'm having issues when it comes to reshaping the data.

I want to display the number of Red/Amber/Green ratings for each metric and have this react based on the Country and Region selected.

The value boxes are working for the most part but all the ideas I've tried through searching SO have either resulted in no bar chart or errors.

My code:


    Country <-  c('England', 'Scotland', 'Wales', 'Ireland', 'Spain', 'England', 'Scotland', 'Wales', 'Ireland', 'Spain', 'England', 'Scotland', 'Wales', 'Ireland', 'Spain' , 'England', 'Scotland', 'Wales', 'Ireland', 'Spain')
    
    Region  <- c('North' , 'East', 'South', 'South', 'North' , 'South', 'East', 'North' , 'South', 'West', 'North' , 'South' , 'North' , 'West', 'North' , 'West', 'West', 'East', 'East', 'South')
    
    Value   <- c(100, 150, 400, 300, 100, 150, 300, 200, 500, 600, 300, 200, 250, 300, 100, 150, 300, 200, 500, 600)
    
    Outcomes <- c('Green', 'Red','' , 'Amber', 'Green', 'Green', 'Red','' , 'Red', 'Amber', 'Red', 'Green', 'Green', 'Green','' ,'' , 'Amber', 'Amber', 'Red', 'Red')
    
    Outputs <- c('Red', 'Green', 'Green', 'Green', '','' , 'Amber', 'Green', 'Red','' , 'Red', 'Amber', 'Red', 'Green', 'Green', '','' , 'Amber', 'Amber', 'Red')
    
    Risk <- c('Green', 'Green', 'Red', 'Red','' , 'Amber', 'Green', 'Green', 'Amber','' , 'Green', 'Red', 'Amber', 'Green', 'Green', 'Red', '', 'Red', 'Amber', '')
    
    
    Joined_data <- data.frame(Country, Region, Value, Outcomes, Outputs, Risk)


list<- unique(Joined_data$Country)
list2 <- unique(Joined_data$`Region`)

UI

ui<- dashboardPage(
  dashboardHeader(title = "Performance", titleWidth = 800),
  
  
  dashboardSidebar(selectizeInput(inputId = "Country", label = "Country", choices = c('All', list)),
                  (selectizeInput(inputId = "Region", label = "Region", choices = c('All', list2)))),
  
              
  
  
  
  dashboardBody(
   
 
    
    fluidRow(
      box(valueBoxOutput(outputId = "Total", width = 12), title = "Total"),
      box(valueBoxOutput(outputId = "Value", width = 12), title = "Value"),
      plotOutput(outputId = "plot1", width = 600 , height = 600), title = "Metric RAG Rating",

      
    )
  ),

)

server <- function(input, output, session) { 
  
Test <- reactive({
  if(input$Country == 'All') {
    Joined_data 
  } else {
  
  Joined_data %>%
    filter(`Country` == input$Country, `Region` == input$Region)
  
}})
  
  
  output$Total <- renderValueBox({
    
    
    
   valueBox(Test() %>%
      tally(), 
    
    req(input$Country),
    color = "olive")
    
  })
  
  output$Value <- renderValueBox({
    
    
    
    valueBox(Test() %>%
               summarise("Value" = sum(`Value (Annualised)`)) %>%
               prettyNum(big.mark = ","), 
             
             req(input$Country),
             color = "olive", icon = icon("pound-sign"))
    
  })


  output$plot1 <-renderPlot({
    
   Test() %>%
    gather(metric, RAG, Outcomes:Risk) #%>%
      group_by(metric, RAG) %>%
      dplyr::summarise(n = n())
      
    ggplot(data= Test(), aes(x= metric, y= n, color = RAG, fill = RAG, title = "RAG Rating")) +
                geom_bar(stat = "identity", position=position_dodge())
    
  req(input$Region)
      
  
  })
  
  Country.choice <- reactive({
    Joined_data %>% 
      filter(`Country` %in% input$Country) %>%
      pull(`Region`)
  })
  
  observe({
    
    updateSelectizeInput(session, "Region", choices = Country.choice())
    
  })
  
  }

shiny::shinyApp(ui=ui,server=server)

I am getting an error - object 'metric' not found. so it must be something to do with gather()

Anyone have any ideas?

Please provide some example data, thanks! – starja Nov 03 '20 at 14:10 — starja, Nov 03 '20 at 14:10
I've added in some sample data now – user14142459 Nov 03 '20 at 14:49 — user14142459, Nov 03 '20 at 14:49

YBS · Accepted Answer · 2020-11-03T15:36:18.043

You need a few req() and a missing %>% in plot1. You can remove the missing value of RAG and use scale_fill_manual to match the color.

server <- function(input, output, session) { 
  
  Test <- reactive({
    req(input$Country)
    if(input$Country == 'All') {
      Joined_data 
    } else {
      Joined_data %>%
        filter(`Country` == input$Country, `Region` == input$Region)
      
    }})
  
  
  output$Total <- renderValueBox({
    valueBox(req(Test()) %>%
               tally(), req(input$Country), color = "olive")
  })
  
  output$Value <- renderValueBox({
    req(Test())
    valueBox(Test() %>%
               summarise("Value" = sum(Value)) %>%
               #summarise("Value" = sum(`Value (Annualised)`)) %>%
               prettyNum(big.mark = ","), 
             
             req(input$Country),
             color = "olive", icon = icon("pound-sign"))
    
  })
  
  
  output$plot1 <-renderPlot({
    req(Test())
    Test() %>%
      gather(metric, RAG, Risk) %>%
      group_by(metric, RAG) %>%
      dplyr::summarise(n = n()) %>% filter(RAG!="") %>%  
      ggplot(aes(x= metric, y= n, color = RAG, fill = RAG, title = "RAG Rating")) +
      geom_bar(stat = "identity", position=position_dodge()) +
      scale_fill_manual(values=c("Amber"="goldenrod1","Green"="green","Red"="red")) +
      scale_color_manual(values=c("Amber"="goldenrod1","Green"="green","Red"="red"))
  })
  
  Country.choice <- reactive({
    
    Joined_data %>% 
      filter(Country %in% req(input$Country)) %>%
      pull(Region)
  })
  
  observe({
    
    updateSelectizeInput(session, "Region", choices = Country.choice())
    
  })
  
}

shiny::shinyApp(ui=ui,server=server)

This is it exactly. Thank you so much!! Could you explain the need for req() to me or point me somewhere I can read about it? — user14142459, Nov 03 '20 at 15:43
It is mainly to handle missing inputs at the beginning. Please see here: https://shiny.rstudio.com/articles/req.html — YBS, Nov 03 '20 at 16:15

Reactive Bar Chart in Shiny with gather

1 Answers1