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?

Answer 1

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)