CODEWITHSUNDEEP
rdatatablesdt
noodlez
noodlez

Reputation: 53

Change cell colour in datatable to varying colours based on duplicated data

I have the following piece of code you can run in R. It is a datatable where I change the colour of the cells depending on whether they are equal to any other values in the column. So far I am able to change the colour (only to red so far) of some of the cells based on their values, for only the given column names that are inputted (Sepal.Length, Sepal.Width). I am trying to colour all the duplicate in the same column the same colour, but vary the colour for different duplicates.

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

For example the 3's in Sepal.Length, I want that to be red, but the duplicated 3's in Sepal.Width to be a different colour. Any ideas?

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

Upvotes: 0

Views: 194

Answers (1)

Susan Switzer
Susan Switzer

Reputation: 1922

I am able to accomplish outside of JS by piping 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')))

I was not able to locate value of 3 in Sepal.Length, so I used value of 5 for this example enter image description here

Upvotes: 1

Related Questions