r - How do I change the color of an infobox in shinydashboard based on the value displayed -
i trying creating simple weather display, change infobox color based on temperature. color value correct displays correctly, color parameter not recognize 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) { : condition has length > 1 , first element used
the code shown below critical lines preceded 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 produces error. color variable passed correctly displayed 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 sets color output$color <- rendertext({getcolor(input$station)}) # } shinyapp(ui, server)
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)
Comments
Post a Comment