Dynamic conditions in formattable

Question

I am using formattable to implement some conditional colour formatting in a table in a shiny app. For instance, let's say I want to colour cells below the value 2, green, above 5, red, and between 2 and 5, orange. I would write my formatter function like this:

formatter(
  "span", 
  style = x ~ style(
  color = 'white',
  'background-color' =  
    ifelse(x > 5, "red",
      ifelse(x > 2 & x <= 5, "orange",
        "green"))))

However, what I really want to do is have those colour threshold values, i.e., 2 and 5, to be able to be changed by the user.

So let's say user_low and user_high are defined by the user:

col_format <- 
  formatter(
      "span", 
      style = x ~ style(
      color = 'white',
      'background-color' =  
        ifelse(x > input$user_high, "red",
          ifelse(x > input$user_low & x <= input$user_high, "orange",
            "green"))))

If I now try to feed this formatter into formattable inside my shiny app:

formattable(mtcars, col_format)

I get the following error:

'col_format' of mode 'function' was not found

Seemingly input$user_low and input$user_high are not evaluated and are instead treated as strings inside the formatter. I've tried eval(), eval(parse()), to no avail.

Any ideas?

Answer 1

Your code is almost functional, but if you want to use input elements such as input$user_high in an expression, you have to use a reactive.

This will happen in order:

1. The values of the input elements change. (either input$user_low, or input$user_high)
2. The column formatting condition (col_format) will update because its dependency changed.
3. The dataTableOutput is rerendered because it depends on col_format.

Example code:

library(shiny)
library(formattable)
library(DT)

ui <- fluidPage(
  sidebarLayout(
    sidebarPanel(
      numericInput("user_low", "User low", value = 2, min = 1, max = 5),
      numericInput("user_high", "User high", value = 8, min = 6, max = 10)
    ),

    mainPanel(
      DT::dataTableOutput("table")
    )
  )
)

server <- function(input, output) {
  output$table <- DT::renderDataTable( {
    as.datatable(formattable(mtcars, list(
      cyl = col_format()
    )))
  })

  col_format <- reactive( {
    formatter(
      "span",
      style = x ~ style(
        color = 'white',
        'background-color' =
          ifelse(x > input$user_high, "red",
                 ifelse(x > input$user_low & x <= input$user_high, "orange",
                        "green"))))
  })

}

shinyApp(ui, server)

Edit: To apply the formatter to every column (as per your comment), you can use lapply as shown in the Dynamically generating formatters section in the Formattable vignette. The code below applies the formatting to the whole dataset.

Code:

output$table <- DT::renderDataTable( {
  as.datatable(formattable(mtcars, lapply(1:ncol(mtcars), function(col) {
    area(row = 1:nrow(mtcars), col) ~ col_format() 
  })))
})