Search code examples
rcolorsdatatablesdt

Edit Gradient Colors in DataTable to Diverge Away from Value in Specific Columns (R)

I have a data table with several columns, three of which I'm interested in shading the background color of dependent on whether or not its above or below another value in a different column.

Let's say I'm using the mtcars dataset.

head(mtcars)
                   mpg cyl disp  hp drat    wt  qsec vs am gear carb
Mazda RX4         21.0   6  160 110 3.90 2.620 16.46  0  1    4    4
Mazda RX4 Wag     21.0   6  160 110 3.90 2.875 17.02  0  1    4    4
Datsun 710        22.8   4  108  93 3.85 2.320 18.61  1  1    4    1
Hornet 4 Drive    21.4   6  258 110 3.08 3.215 19.44  1  0    3    1
Hornet Sportabout 18.7   8  360 175 3.15 3.440 17.02  0  0    3    2
Valiant           18.1   6  225 105 2.76 3.460 20.22  1  0    3    1

I want to turn this into a datatable and change the background of drat and wt depending on if their values are higher or lower than the reference column values of carb. For example, I would compare the value of drat (3.90) to the value of carb (4). Then, I would do the same comparing the value of wt (2.620) to the value of carb (4). I want to have values that are less than the reference value in a decreasing gradient from light red to darker red. Then, I want to have the values that are more than the reference value in an increasing gradient from light blue to darker blue. If the values of either drat or wt were equal to carb, then the background color should be white.

I have been able to use some old code that gets me started:

library(DT)

dtable <- datatable(mtcars, rownames=TRUE, options = list(lengthChange = FALSE, dom='t'))

colRamp <- colorRamp(c("lightcoral","white","darkblue"))

for(column in names(mtcars)[5:6]){
  x <- na.omit(mtcars[[column]])
  brks <- quantile(x, probs = seq(.05, .95, .01))
  RGB <- colRamp(c(0, (brks-min(x))/(max(x)-min(x))))
  clrs <- apply(RGB, 1, function(rgb){
    sprintf("rgb(%s)", toString(round(rgb,0)))
  })
  dtable <- dtable %>% 
    formatStyle(column, backgroundColor = styleInterval(brks, clrs))
}

dtable

How would I adjust the colors in those 2 columns to reference the carb column as the "middle" point?

Solution

  • If I correctly understand, I would base the colors on the values of the differences with the reference column. That is, for drat:

    library(DT)

dat <- mtcars
x <- dat[["drat"]] - dat[["carb"]]
lowest  <- min(x)
highest <- max(x)
# function to map from (lowest, highest) to (0, 1), mapping 0 to 0.5
interpfun <- splinefun(
  c(lowest, 0, highest),
  c(0, 0.5, 1)
)
# map x
y <- interpfun(x)
# function mapping (0, 1) to a color; 0.5 is sent to white 
colfunc <- colorRamp(c('blue', 'white', 'red'))
# get the colors 
cols <- colfunc(y)
# these are rgb codes, we convert them to hex codes
clrs <- rgb(cols[, 1L], cols[, 2L], cols[, 3L], maxColorValue = 255)


datatable(dat) %>% 
  formatStyle(
    "drat", 
    backgroundColor = styleEqual(dat[["drat"]], clrs)
  )

    Edit

    There's a problem because of some equal values. So add clrs to the data as a new column and use styleValue():

    dat$clrs <- clrs
datatable(dat) %>% 
  formatStyle(
    "drat", valueColumns = "clrs",
    backgroundColor = styleValue()
  )

    Of course it remains to hide the clrs column.

    enter image description here