多列DT R上的formatStyle

Question

I have a data.frame with one ID column and multiple numeric columns, the amount of numeric columns can differ. Of these numeric columns I want to color all values above the column mean green and all values below the column mean red. The code below give my desired outcome, but it is not a generic code for data frames with more or less numeric columns.

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

I would like to replace the code above with the code below but that does not work. The code below will also work when the number of numeric columns changes.

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

Is this possible? So yes, how?

Answer 1

You can do it with addition calculation like

(Not work with same value in different column)

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

Update

You can generate rowCallback like

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"),"}" ))
  )
)