0

I want a way to color multiple cells in a data table if given their row and column indexes, but each with different set of pre-defined colors.

I've found a solution from here that allows changing the color for multiple cells, however only with one color ("orange"). I want to modify this function so that I am able to set different colors for different cells. I currently have a matrix of the colors to be assigned in each cell, by row and column number. Wondering if there is a way to integrate this matrix to select the defined color for each row/column combination. Any insight would be much appreciate.

Including the code snippet from the linked solution below.

library(DT)

changeCellsColor <- function(rows, cols){
  stopifnot(length(rows) == length(cols))
  c(
    "function(row, data, num, index){",
    sprintf("  var rows = [%s];", paste0(rows-1, collapse = ",")),
    sprintf("  var cols = [%s];", paste0(cols, collapse = ",")),
    "  for(var i = 0; i < rows.length; ++i){",
    "    if(index == rows[i]){",
    "      $('td:eq(' + cols[i] + ')', row)",
    "        .css({'background-color': 'orange'});",
    "    }",
    "  }",
    "}"
  )
}
datatable(iris,
          options = list(
            dom = "t",
            rowCallback = JS(changeCellsColor(c(1,3), c(2,1)))
          )
)
nseq
  • 3
  • 1

1 Answers1

0

Sure could this be achieved. First step is to adapt the code by @StephaneLaurent which means adding a third argument to pass a vector of colors. Second step would be to reshape your matrix to a dataframe using e.g. reshape2::melt. Afterwards the function is easily applied to color each dateable cell:

library(DT)

changeCellsColor <- function(rows, cols, colors) {
  stopifnot(length(rows) == length(cols))
  c(
    "function(row, data, num, index){",
    sprintf("  var rows = [%s];", paste0(rows - 1, collapse = ",")),
    sprintf("  var cols = [%s];", paste0(cols, collapse = ",")),
    sprintf("  var colors = [%s];", paste0("'", colors, "'", collapse = ",")),
    "  for(var i = 0; i < rows.length; ++i){",
    "    if(index == rows[i]){",
    "      $('td:eq(' + cols[i] + ')', row)",
    "        .css({'background-color': colors[i]});",
    "    }",
    "  }",
    "}"
  )
}

mat <- matrix(c("orange", "blue", "red", "green"), nrow = 10, ncol = 4)
mat_df <- reshape2::melt(mat)

datatable(iris,
  options = list(
    dom = "t",
    rowCallback = JS(changeCellsColor(
      mat_df$Var1,
      mat_df$Var2,
      mat_df$value
    ))
  )
)

enter image description here

stefan
  • 90,330
  • 6
  • 25
  • 51