R shiny conditionally change numericInput background colour

Question

Consider the following code:

library(shiny)

ui <- shinyUI(
    fluidPage(
        column(12,
               numericInput("test", h5("Test value:"), value = 500, min = 0, max = 10000, step = 100, width = '200px')
        )
    )
)

server <- function(input, output) {
}

shinyApp(ui = ui, server = server)

I would like to change the background colour of the numericInput widget to red based on invalid user input. So if the user enters text, or a value outside the min and max range, then the widget should be coloured red.

Note that I cannot use the solution of using a CSS file with, for example:

input:invalid {
    background-color: #FFCCCC !important;
}

The reason is that is will colour the background red if the user enters any value that isn't a multiple of the 'step' value in the numericInput statement (see: R shiny numericInput step and min value interaction for details).

So how can I implement my own manual validation as above by styling conditionally based on validation rules I define? That is, so I can apply any rules stating what's valid, such as:

• if (is.numeric(input$test))
• if (input$test >= 0)
• if (input$test <= 10000)

Answer 1

You can achieve this using Shinyjs. You can adapt the rules for color change as you want (I defined the rules based on the 5 step sequence from your other question).

library(shiny)

jsCode <- '
shinyjs.backgroundCol = function(params) {
var defaultParams = {
id : null,
col : "red"
};
params = shinyjs.getParams(params, defaultParams);
var el = $("#" + params.id);
el.css("background-color", params.col);
}'

ui <- fluidPage(
  useShinyjs(),
  extendShinyjs(text = jsCode),
  sidebarPanel(
    numericInput("val", "Enter value:", value=50, min = 0, step = 5)
  )
)

server <- function(input, output, session) {
  observeEvent(input$val, {
    x <- input$val
    if (x %% 5 != 0 | x < 0 | is.na(x))  {
      js$backgroundCol("val","red")
    } else {
      js$backgroundCol("val","white")
    }
  })
}

shinyApp(ui, server)

Answer 2

Here's another answer if you want to avoid using JS, but want an object (or set of objects) to update their color based on some user input :

#define reactive value
color <- reactiveVal(#77787B)

#Current Color----
#some user action
  observeEvent(input$some_action,{
    color <- switch (condition,
                     "case1" = "#57a595",
                     "case2" = "#f4552e",
                     "#77787B" #default color
                     
    )
  })
  output$color_style <- renderUI({
    #any valid selector can be used in place of "elementId"
    tags$style(HTML(paste0("#elementId {
      background-color: ",color,";}")))
  })

The above code would go in your server script and then you would just need to define the input objects and the element(s) who's color you are modifying in the ui script.

This can be used to update any other CSS properties as well