闪亮的反应条形图与聚集

Question

我正在尝试在 Shiny 中向我的仪表板添加条形图，但在重塑数据时遇到问题。

我想显示每个指标的 Red/Amber/Green 评分数量，并根据所选的国家和地区做出反应。

值框在大部分情况下都有效，但我通过搜索 SO 尝试过的所有想法要么没有条形图，要么没有错误。

我的代码：


    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)

我遇到错误 - 找不到对象 'metric'。所以它一定与 gather()

有关

有人有什么想法吗？

Answer 1

您需要一些 req() 和 plot1 中缺少的 %>%。可以去掉RAG的缺失值，用scale_fill_manual匹配颜色

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)

闪亮的反应条形图与聚集

Reactive Bar Chart in Shiny with gather

r

bar-chart

shiny

reactive