Question

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

报告

validateColor（颜色）出错：无效的颜色：。有效颜色有：红色，黄色，浅绿色，蓝色，浅蓝色，绿色，海军蓝，蓝绿色，橄榄色，石灰色，橙色，紫红色，紫色，栗色，黑色。另外：警告信息：在if（％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)

Answer 2

嗨，我找到了彩色的解决方案

使用这个是因为当值为 NA 时它不返回颜色而是 NA

color =ifelse(is.na(value), "red", ifelse(value > 0, "green", "orange")))

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

2 个答案: