r - 如何根据显示的值更改 shinydashboard 中信息框的颜色

Question

我正在尝试创建一个简单的天气显示，它会根据温度改变信息框的颜色。颜色值正确，因为它显示正确，但颜色参数无法识别颜色。

报告

validateColor(color) 错误:无效颜色:.有效颜色有:红色、黄色、浅绿色、蓝色、浅蓝色、绿色、海军蓝、蓝绿色、橄榄色、青柠色、橙色、紫红色、紫色、栗色、黑色。 另外: 警告信息: 在 if (color %in% validColors) { 中: 条件的长度 > 1，并且只使用第一个元素

代码如下所示，关键行前面有注释

    library(shiny)
    library(shinydashboard)
    library(RWeather)

    getColor <-  function(station) {
      t <-  as.numeric(getWeatherFromNOAA(station_id = station, message = FALSE)$temp_c)
      if(t  > 30)
      {return('red')}
      else if (t < 5) 
      {return('blue')}
      else return('yellow')
    }

    header <- dashboardHeader(title =  'Current weather')
    sidebar <- dashboardSidebar()
    boxCity <-  box(selectInput('station', 'City:', choices = c('Atlanta' = 'KATL',  'Chicago' = 'KORD', 'Fairbanks' = 'PAFA', 'New York' = 'KJFK', 'Phoenix' ='KPHX'), selected = 'KATL'))
    boxCondition <-  box(title = 'Current conditions: ', textOutput('condition'), background = 'blue')
# line that produces error. The color variable is passed correctly as it is displayed by textOutput('color')
    valueBoxC <-  valueBox(textOutput('color'), width=3, subtitle = 'C', color= textOutput('color'))
# 
    valueBoxF <-  valueBox(textOutput('F'), width=3, subtitle = "F")
     boxTime <-  box(textOutput('time'))
    row1 <-  fluidRow(boxCity)
    row2 <-  fluidRow(boxCondition, boxTime)
    row3 <-  fluidRow(valueBoxC, valueBoxF)
    body <- dashboardBody(row1,row2,row3)
    ui <- dashboardPage(header,sidebar,body)

    server <- function(input, output) {
    output$text <- renderText({paste(input$station, ' weather watch')})
    output$condition <-  renderText({getWeatherFromNOAA(station_id = input$station, message = FALSE)$condition})
    output$time <-  renderText({getWeatherFromNOAA(station_id = input$station, message = FALSE)$observation_time})
    output$F <-  renderText({getWeatherFromNOAA(station_id = input$station, message = FALSE)$temp_f})
    output$C <-  renderText({getWeatherFromNOAA(station_id = input$station, message = FALSE)$temp_c})
# code that sets the color
    output$color <-  renderText({getColor(input$station)})
# 
    }

    shinyApp(ui, server)

Answer 1

我解决了。

library(shiny)
library(shinydashboard)
library(RWeather)

header <- dashboardHeader(title =  'Current weather')
sidebar <- dashboardSidebar()
boxCity <-
  box(selectInput(
    'station', 'City:', choices = c(
      'Atlanta' = 'KATL',  'Chicago' = 'KORD', 'Fairbanks' = 'PAFA', 'New York' = 'KJFK', 'Phoenix' =
        'KPHX'
    ), selected = 'KATL'
  ))
boxCondition <-
  box(title = 'Current conditions: ', textOutput('condition'), background = 'blue')
boxTime <-  box(textOutput('time'))
row1 <-  fluidRow(boxCity)
row2 <-  fluidRow(boxCondition, boxTime)
row3 <-  fluidRow(valueBoxOutput("vboxC"), valueBoxOutput("vboxF"))
body <- dashboardBody(row1,row2,row3)

ui <- dashboardPage(header,sidebar,body)

server <- function(input, output) {
  output$condition <-
    renderText({
      getWeatherFromNOAA(station_id = input$station, message = FALSE)$condition
    })
  output$time <-
    renderText({
      getWeatherFromNOAA(station_id = input$station, message = FALSE)$observation_time
    })
  output$vboxC <- renderValueBox({
    t <-
      as.numeric(getWeatherFromNOAA(station_id = input$station, message = FALSE)$temp_c)
    if (t  > 30)
    {
      valueBox(t, width = 3, subtitle = 'C', color = 'red')
    }
    else if (t < 10)
    {
      valueBox(t, width = 3, subtitle = 'C', color = 'blue')
    }
    else {
      valueBox(t, width = 3, subtitle = 'C', color = 'yellow')
    }
  })
  output$vboxF <- renderValueBox({
    t <-
      as.numeric(getWeatherFromNOAA(station_id = input$station, message = FALSE)$temp_f)
    if (t  > 86)
    {
      valueBox(t, width = 3, subtitle = 'F', color = 'red')
    }
    else if (t < 50)
    {
      valueBox(t, width = 3, subtitle = 'F', color = 'blue')
    }
    else {
      valueBox(t, width = 3, subtitle = 'F', color = 'yellow')
    }
  })
}

shinyApp(ui, server)