formatStyle w wielu kolumnach DT R

Question

Posiadam data.frame z jedną kolumną ID i wieloma kolumnami numerycznymi, ilość kolumn numerycznych może się różnić. Z tych kolumn numerycznych chcę pokolorować wszystkie wartości powyżej średniej kolumny zielonej, a wszystkie wartości poniżej kolumny oznaczają średnią czerwoną. Poniższy kod daje pożądany wynik, ale nie jest to ogólny kod dla ramek danych z mniej lub bardziej numerycznymi kolumnami.

library(DT) 

data2 <- cbind(ID = "some ID",iris[,1:4]) 

    datatable(
     data2, rownames = FALSE, class = 'cell-border stripe', 
     options = list(
     dom = 't', pageLength = -1, lengthMenu = list(c(-1), c('All')) 
    ) 
) %>% 
    formatStyle(colnames(data)[2], backgroundColor = styleInterval(mean(data[,2]), c("red","green"))) %>% 
    formatStyle(colnames(data)[3], backgroundColor = styleInterval(mean(data[,3]), c("red","green"))) %>% 
    formatStyle(colnames(data)[4], backgroundColor = styleInterval(mean(data[,4]), c("red","green"))) %>% 
    formatStyle(colnames(data)[5], backgroundColor = styleInterval(mean(data[,5]), c("red","green"))) 

Chciałbym zastąpić powyższy kod poniższym kodem, ale to nie działa. Poniższy kod będzie działał również po zmianie liczby kolumn numerycznych.

datatable(
    data2, rownames = FALSE, class = 'cell-border stripe', 
    options = list(
    dom = 't', pageLength = -1, lengthMenu = list(c(-1), c('All')) 
) 
) %>% 
    formatStyle(colnames(data2)[2:ncol(data2)], backgroundColor = styleInterval(colMeans(data2[,2:ncol(data2)]), c("red","green"))) 

Czy to możliwe? Więc tak, jak?

Answer 1

Można zrobić to z obliczeń dodawania jak

(nie działa z taką samą wartość w innej kolumnie)

hepl_1=sapply(2:ncol(data2),function(i) ifelse(data2[[i]]>=mean(data2[[i]]),"rgb(255,0,0)","rgb(0,255,0)")) 
help_3=as.matrix(data2[2:ncol(data2)]) 

datatable(
    data2, rownames = FALSE, class = 'cell-border stripe', 
    options = list(
    dom = 't', pageLength = -1, lengthMenu = list(c(-1), c('All')) 
) 
) %>% 
    formatStyle(colnames(data2)[2:ncol(data2)], backgroundColor = styleEqual(help_3, hepl_1)) 

aktualizacji

Można wygenerować rowCallback jak

datatable(
    data2, rownames = FALSE, class = 'cell-border stripe', 
    options = list(
    dom = 't', pageLength = -1, lengthMenu = list(c(-1), c('All')), 
    rowCallback=JS(paste0("function(row, data) {\n", 
          paste(sapply(2:ncol(data2),function(i) paste0("var value=data[",i-1,"]; if (value!==null) $(this.api().cell(row,",i-1,").node()).css({'background-color':value <=", mean(data2[[i]])," ? 'red' : 'green'});\n") 
         ),collapse = "\n"),"}")) 
) 
)