Блог

Мне нужно выделить ячейки в соседних столбцах, если они отличаются. Вот автономный код для проблемы, которую я пытаюсь решить (не работает):

 library(DT)
library(tidyverse)
`%!=na%` <- function(e1, e2) (e1 != e2 | (is.na(e1) amp; !is.na(e2)) | (is.na(e2) amp; !is.na(e1))) amp; !(is.na(e1) amp; is.na(e2))

df <- tibble(
  a = c('a',NA,'','d','a'),
  b = c('a','b','c','d','a'),
  c = c(1,1,2,4,5),
  d = c(1,2,3,4,6)
)
rgbcolors =  cbind(apply(grDevices::col2rgb(ifelse(!(df$a %!=na% df$a), "white", "pink")), 2, 
                        function(rgb) sprintf("rgb(%s)", paste(rgb, collapse=","))),
                  apply(grDevices::col2rgb(ifelse(!(df$a %!=na% df$b), "white", "pink")), 2, 
                        function(rgb) sprintf("rgb(%s)", paste(rgb, collapse=","))),
                  apply(grDevices::col2rgb(ifelse(!(df$c %!=na% df$c), "white", "pink")), 2, 
                        function(rgb) sprintf("rgb(%s)", paste(rgb, collapse=","))),
                  apply(grDevices::col2rgb(ifelse(!(df$c %!=na% df$d), "white", "yellow")), 2, 
                        function(rgb) sprintf("rgb(%s)", paste(rgb, collapse=","))))

rgbcolors = t(rgbcolors)
rgbcolorsJ = NULL
for (j in 1:dim(rgbcolors)[1])  
  rgbcolorsJ[j] = sprintf("[%s]", paste(sprintf("'%s'", rgbcolors[j,]), collapse=", "))
rgbcolorsArray = sprintf("[%s]", paste(sprintf("%s", rgbcolorsJ), collapse=", "))

column <- c(2,4)
columnsArray = sprintf("[%s]", paste(sprintf("%s", column), collapse=", "))

jscodeCol <- paste("function(row, data, index) {",
                   sprintf("var colors=%s;
                        var columns=%s;
                        for (i = 0; i < columns.length; i  ) {
                        var j = columns[i];
                        var col = colors[j][index];
                        $(this.api().cell(index, j).node()).css('background-color', col);
}",
                           rgbcolorsArray,
                           columnsArray), "}", sep="n")
                   

datatable(df, escape=FALSE, 
          options = list(rowCallback=JS(jscodeCol))
)

 

Следующая модификация кода JS (явная строка # для массива цветов) использует его для раскрашивания без проблем:

 jscodeCol <- paste("function(row, data, index) {",
                   sprintf("var colors=%s;
                        var columns=%s;
                        for (i = 0; i < columns.length; i  ) {
                        var j = columns[i];
                        var col = colors[1][index];
                        $(this.api().cell(index, j).node()).css('background-color', col);
}",
                           rgbcolorsArray,
                           columnsArray), "}", sep="n")

 

Нашел, что происходит — внутренний массив цветов отсчитывался от 0:

 jscodeCol <- paste("function(row, data, index) {",
                   sprintf("var colors=%s;
                        var columns=%s;
                        for (i = 0; i < columns.length; i  ) {
                        var j = columns[i];
                        var col = colors[j-1][index];
                        $(this.api().cell(index, j).node()).css('background-color', col);
}",
                           rgbcolorsArray,
                           columnsArray), "}", sep="n")