How do I change the color of an infobox in shinydashboard based on the value displayed

问题

I am trying to creating a simple weather display, which will change the infobox color based on the temperature. The color value is correct as it displays correctly, but the color parameter will not recognize the color.

It reports

Error in validateColor(color) : Invalid color: . Valid colors are: red, yellow, aqua, blue, light-blue, green, navy, teal, olive, lime, orange, fuchsia, purple, maroon, black. In addition: Warning message: In if (color %in% validColors) { : the condition has length > 1 and only the first element will be used

The code is shown below with the critical lines preceded by a comment

    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)

回答1:

I solved it.

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)

来源：https://stackoverflow.com/questions/32301306/how-do-i-change-the-color-of-an-infobox-in-shinydashboard-based-on-the-value-dis

标签

shinydashboard