R Shiny --> 有条件地高亮条形图

Question

我正在做一个 Shiny 项目来可视化锻炼数据。我仪表板的这个特殊菜单选项卡专注于每个锻炼课程的成本。我有一个滑块来帮助确定我理想的每节课每月费用应该是多少。下面的两个值框通过告诉用户来对滑块输入的位置做出反应：

1.) 我每月需要参加多少节课才能达到每月每节课的费用

2.) 我在多少个月内实现了这个月度成本目标

我有两个问题：

1.) 我不确定我在使用第二个值框时做错了什么。它似乎没有正确响应滑块输入。

2.) 我在值框下方的图表中遇到了每个班级的每月费用问题，我希望突出显示实现目标的特定月份并对滑块输入的位置做出反应。

到目前为止，这是我的代码：

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)

我已尝试运行此代码，但收到一条错误消息：“必须从色调调色板中请求至少一种颜色。”我试过包括

fill = "darkgreen"

进入 geom_bar 行，但随后我得到非反应性条。

任何帮助将不胜感激！谢谢！

Answer 1

有助于查看您的数据并注意警告消息：

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   
...   

所以Specific 对于所有行都是NA。运行您的代码时收到的警告消息告诉我发生了什么：

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

您创建输入数据的方式是问题所在。改变

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

到

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

我明白了

还有一个反应性的第二个值框。

要获得我认为您想要的图表，我希望您需要将 fill=Specific 更改为 fill=as.factor(Specific) 并相应地调整图例。