Измените цвет ячейки в datatable на различные цвета на основе дублированных данных - PullRequest
Новая
       20

Измените цвет ячейки в datatable на различные цвета на основе дублированных данных

0 голосов
/ 01 мая 2020

У меня есть следующий фрагмент кода, который вы можете запустить в R. Это таблица данных, в которой я меняю цвет ячеек в зависимости от того, равны ли они другим значениям в столбце. Пока что я могу изменить цвет (пока только красный) некоторых ячеек на основе их значений только для заданных имен столбцов, которые вводятся (Sepal.Length, Sepal.Width). Я пытаюсь закрасить все дубликаты в одном столбце одним и тем же цветом, но меняю цвет для разных дубликатов. 

Sepal.Length        Sepal.Width
3                   9
4                   3
5                   3
3                   4
8                   9
4                   1
3                   2

Например, 3 в Sepal.Length, я хочу, чтобы это было красным, но дублированные 3 в Sepal.Width, чтобы быть другим цветом. Есть идеи? 

library(DT)

data2 <- cbind(ID = "ID",iris[,1:4])
getNumber <- function(colname, df) {
  which( colnames(df)==colname )
}

getCondition<-function(col, df) {
  lines <- ''
  lines = paste0(lines, apply(df[col], 2, function(i) {
    line <- paste('value == ', i)
  }))
  conidtion <- paste0(lines)
  print(conidtion)
}

names <- c("Sepal.Length", "Sepal.Width")

JSfunc <- paste0("function(row, data) {\n",
       paste(sapply(names,function(i) paste0(
         "var value=data['",getNumber(i, data2) -1,"'];
         if (value!==null) $(this.api().cell(row,'",getNumber(i, data2) - 1,
         "').node()).css({'background-color': ", getCondition(i, data2) ," ? 'red' : ''});\n")
       ), collapse = "\n"),"}" )

datatable(
  data2, rownames = FALSE, class = 'cell-border stripe',
  options = list(
    dom = 't', pageLength = -1, lengthMenu = list(c(-1), c('All')),
    rowCallback=JS(JSfunc)
  )
)

1 Ответ

2 голосов
/ 01 мая 2020

Я могу выполнить sh вне JS с помощью конвейера formatStyle 

library(DT)

data2 <- cbind(ID = "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(columns = 'Sepal.Length', 
        valueColumns = 'Sepal.Length',
        backgroundColor = styleEqual(levels = c(5), 
                                     values = c('red'))) %>% 
formatStyle(columns = 'Sepal.Width', 
          valueColumns = 'Sepal.Width',
          backgroundColor = styleEqual(levels = c(3), 
                                       values = c('yellow')))

Мне не удалось найти значение 3 в Sepal.Length, поэтому я использовал значение 5 для этого пример enter image description here

...