R Shiny --> 有条件地突出显示条形图

Question

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

1.) 每个 class

我每个月需要参加多少次 classes 才能达到每月的费用

2.) 我有多少个月达到了这个月度成本目标

我这里有两个问题：

1.) 我不确定第二个值框有什么问题。它似乎没有正确响应滑块输入。

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

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

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) 并相应地调整图例。

R Shiny --> 有条件地突出显示条形图

R Shiny --> Conditionally Highlight Bar Graphs

r

dplyr

shiny

reactive

geom-bar