Coloriser les cellules d'une colonne en fonction de ses quantiles en utilisant le paquet DT et le faire pour n'importe quelle colonne

Question

Je voudrais coloriser les cellules de chaque colonne d'une table en fonction de ses quantiles et le faire pour chaque colonne. Pour cet exercice, j'ai utilisé le paquet DT.

Ci-dessous vous trouverez un exemple reproductible qui fait la colorisation des cellules sur la base quantiles des figures de toute la 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)) 

Je voudrais faire la même chose, mais en colonnes . Voici le code que j'ai écrit à le faire:

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)) 

je commence à faire une application sur des colonnes pour obtenir après les quintiles colonne (brks) et de créer des couleurs assorties répliquées (r). Ensuite, je mets ces matrices en tant que vecteurs que styleInterval accepte seulement les vecteurs. De plus, j'ajoute un nouvel élément au vecteur r puisque je pense que l'argument "valeurs" de styleInterval devrait contenir un élément de plus que l'argument "cuts".

J'ai quelques problèmes avec le code, en particulier "coupes 'doit être trié de plus en plus" apparaît. Quelqu'un at-il une idée sur le point de le résoudre?

Answer 1

Ce code fait l'affaire, avec une demande pour les couleurs et la fonction eval pour chaque élément ième de mes vecteurs brks et 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 = " "))))