CODEWITHSUNDEEP
cssrformattingbackground-colordt
guiotan
guiotan

Reputation: 170

Colorize cells of a column based on its quantiles using DT package and do it for any column

I would like to colorize cells of each column of a table based on its quantiles and do it for each column. For this exercice, I have been using DT package.

Below you will find an reproducible example which does the colorization of cells based on the quantiles of figures of the whole table:

set.seed(1)
df = as.data.frame(cbind(matrix(round(rnorm(50), 3), 10), sample(0:1, 10, TRUE)))
brks <- quantile(df, probs = seq(.05, .95, .05), na.rm = TRUE)
clrs <- round(seq(255, 40, length.out = length(brks) + 1), 0) %>%{paste0("rgb(255,", ., ",", ., ")")}
datatable(df) %>% formatStyle(names(df), backgroundColor = styleInterval(cuts=brks,values=clrs))

I would like to do the same but column-based. Here's the code I wrote to do so:

set.seed(1)
df = as.data.frame(cbind(matrix(round(rnorm(50), 3), 10), sample(0:1, 10, TRUE)))
brks <- apply(df,MARGIN=2,FUN=quantile,probs=seq(.05, .95, .05))
clrs <- round(seq(255, 40, length.out = nrow(brks)), 0) %>% {paste0("rgb(255,", ., ",", ., ")")}
r=replicate(ncol(brks),clrs)
r=as.vector(r)
r=append(r,"rgb(255,20,20)")
brks <- as.vector(brks)
datatable(df) %>% formatStyle(names(df), backgroundColor = styleInterval(cuts=brks,values=r))

I start doing an apply on columns to get the column-based quantiles (brks) and create matched replicated colors (r). Then I put these matrices as vectors as styleInterval only accepts vectors. Besides, I append a new element to vector r since I think the argument "values" of styleInterval should contain one more element than the argument "cuts".

I have some issues with the code, especially "cuts' must be sorted increasingly" is appearing. Has anyone any idea about to solve it?

Upvotes: 0

Views: 591

Answers (1)

guiotan
guiotan

Reputation: 170

This code does the trick, with an apply for the colors and eval function for each ith element of my vectors brks and clrs:

set.seed(1)
df <- cbind.data.frame(matrix(round(rnorm(50), 3), 10), sample(0:1, 10, TRUE))
brks <- apply(df, 2, quantile, probs=seq(.05, .95, .05), na.rm=T)
clrs <- apply( brks, 2, function(x) round(seq(255, 40, length.out = length(x)+1), 0) %>% {paste0("rgb(255,", ., ",", ., ")")})
eval(parse(text=paste0("datatable(df) ", paste(sapply(1:ncol(df), function(i) paste0("%>% formatStyle(names(df)[",i,"], backgroundColor = styleInterval(brks[,",i,"], clrs[,",i,"]))") ), collapse = " " ))))

Upvotes: 3

Related Questions