R Shiny --> Conditionally Highlight Bar Graphs

Question

I am working on a Shiny project to visualize exercise data. This particular menu tab of my dashboard is focused on the cost per exercise class. I have a slider to help determine what my ideal monthly cost per class should be. Two value boxes below react to the position of the slider input by telling the user:

1.) How many classes I need to attend per month to achieve this monthly cost per class

2.) How many months I achieved this monthly cost goal

I'm having two issues here:

1.) I'm not sure what I'm doing wrong with the second value box. It doesn't seem to be responding properly to the slider input.

2.) I'm having trouble with the monthly cost per class in a plot below the value boxes and I want to have the particular months highlighted where the goal was achieved and react to the position of the slider input.

Here is my code so far:

library(shiny)
library(shinydashboard)
library(ggplot2)
library(dplyr)
library(htmltools)

YearMon<-c("Mar 2019","Apr 2019","May 2019","Jun 2019","Jul 2019", "Aug 2019","Sep 2019",
           "Oct 2019","Nov 2019","Dec 2019","Jan 2020", "Feb 2020", "Mar 2020")
Visits<-c(3,3,4,10,11,11,17,17,15,14,14,16,8)
AvgCost<-c(44.49667,16.58250,16.58250,19.36540,21.10364,21.10364,13.65529,19.24353,15.80933,
           16.58143,16.58143,14.50875,29.01750)

MonthNums<-as.data.frame(cbind(YearMon,Visits,AvgCost))

# Define UI for application
ui <- fluidPage(
  dashboardPage(
    dashboardHeader(title="Dashboard"),
    dashboardSidebar(
      sidebarMenu(
        menuItem("Cost",
                 tabName = "cost_chart",
                 icon=icon("dollar-sign")
        )
      )
    ),
    dashboardBody(
      tabItems(
        tabItem(
          tabName = "cost_chart",
          fluidRow(align="center",
                   sliderInput("slider", "Choose Ideal Monthly Cost Per Class: ",min=5, max=50, step=5,value=0,pre="$",sep=",")),
          fluidRow(splitLayout(cellWidths = c("50%", "50%"),
                               valueBoxOutput("vbox8",width=10),
                               valueBoxOutput("vbox9",width=10))),
          plotOutput("cost_chart"))))))

# Define server logic 
server <- function(input, output) {
  
  output$vbox8 <- renderValueBox({
    valueBox(
      round(233/(input$slider),0),
      "Classes Per Month Needed",
      icon = icon("check-square"),
      color = "teal"
    )
  })
  
  
  ClassNumFilter=reactive({
    MC=MonthNums %>%
      filter(Visits>=round(233/(input$slider),0))
    return(MC)
  })
  
  output$vbox9 <- renderValueBox({
    valueBox(
      dim(ClassNumFilter())[1],
      "Number of Months I Met This Goal",
      icon = icon("check-square"),
      color = "orange")
  })
  
  filtered <- reactive({
    MonthNums$Specific = ifelse(MonthNums$AvgCost >= round(233/(input$slider),0), 1,0)
    return(MonthNums)
  })
  
  output$cost_chart=renderPlot({
    ggplot(data = filtered(), aes(x = YearMon, y = AvgCost, fill=Specific)) +
      geom_bar(stat = "identity", position = "dodge")
    
  })
}

# Run the application 
shinyApp(ui = ui, server = server)

I have tried running this code and I get an error that reads, "Must request at least one colour from a hue palette." I've tried including

fill = "darkgreen"

into the geom_bar line but then I get the non-reactive bars.

Any help would be greatly appreciated! Thank you!

Answer 1

It helps to look at your data and pay attention to warning messages:

print(as_tibble(filtered())
# A tibble: 13 x 4
   YearMon  Visits AvgCost  Specific
   <fct>    <fct>  <fct>    <lgl>   
 1 Mar 2019 3      44.49667 NA      
 2 Apr 2019 3      16.5825  NA      
 3 May 2019 4      16.5825  NA   
...   

So Specific is NA for all rows. The warning message I get when I run your code tells me what's going on:

Warning in Ops.factor(Visits, round(233/(input$slider), 0)) :
  ‘>=’ not meaningful for factors

The way you create your input data is the problem. Change

MonthNums<-as.data.frame(cbind(YearMon,Visits,AvgCost))

to

MonthNums<-as_tibble(cbind(YearMon,Visits,AvgCost))

and I get

along with a reactive second value box.

To get the graph I think you want, I expect you will need to change fill=Specific to fill=as.factor(Specific) and adjust the legend accordingly.