library(shiny)
library(DT)

ui <- fluidPage(
  checkboxInput("click_me", "click me"),
  DT::dataTableOutput("bad_foo"),
  DT::dataTableOutput("good_foo")
)

server <- function(input, output, session) {

  data <- reactive(
    round(data.frame(
      x = runif(5, 0, 5),
      y = runif(5, 0, 10),
      z = runif(5, 0, 20)
    ), 3)
  )

  break_points <- function(x) stats::quantile(x, probs = seq(.05, .95, .05), na.rm = TRUE)
  red_shade <- function(x) round(seq(255, 40, length.out = length(x) + 1), 0) %>% {paste0("rgb(255,", ., ",", ., ")")}


  dt1 <- reactive({
    non_reactive_data <- data()

    brks <- apply(non_reactive_data, 1, break_points)
    clrs <- red_shade(break_points(non_reactive_data))

    rowCallback <- "function(row, non_reactive_data, displayNum, index){"
    for(i in 1:ncol(non_reactive_data)){
      rowCallback <- c(
        rowCallback,
        sprintf("var value = non_reactive_data[%d];", i)
      )
      for(j in 1:nrow(non_reactive_data)){
        rowCallback <- c(
          rowCallback,
          sprintf("if(index === %d){", j-1),
          sprintf("$('td:eq(%d)',row).css('background-color', %s);",
                  i, styleInterval(brks[,j], clrs)),
          "}"
        )
      }
    }
    rowCallback <- c(rowCallback, "}")

    return(DT::datatable(non_reactive_data, options = list(rowCallback = JS(rowCallback))))
  })

  dt2 <- reactive({
    DT::datatable(data())
  })


  output$bad_foo <- DT::renderDT({
    output <- dt1()
    if(input$click_me==TRUE){
      output <- output %>% DT::formatPercentage(1:ncol(data()), 3)
    }
    output
  })

  output$good_foo <- DT::renderDT({
    output <- dt2()
    if(input$click_me==TRUE){
      output <- output %>% DT::formatPercentage(1:ncol(data()), 3)
    }
    output
  })
}

shinyApp(ui, server)