Single/multiple conditions for columns formating w

问题:

This is related to the question in this Is there any similar approach to conditional formating for multiple columns from excel in Shiny,, the solution provided works fine but I am a bit stack in how to extend the code to meet new requirement. So if I have the following dataframe and want to change the background color of five columns based on the following condition:

• for columns X,Y
• if -4 < X < 4 and Y < 10 color of X,Y is pink
• elseif Y >10 color of X,Y is bleu

• else X ="" or Y="" then color of X,Y is white

• For columns A, B,C

• if "A" < 3 then "A" is green else pink
• if "B" < 3 then "B" is green else pink
• if "C" < 3 then "C" is green else pink

I tried to extend the provided solution here but it didn't work. Would anyone help how to go through this.

output$contents <- renderDataTable({
    df <- data.frame(
      id = 1:10, 
      X = c(-2, 4, 40, -0.1228, 2.9, 9, 2.7, 2.7, 31, -30),
      Y = c(-18.9, -19.5, 19.6, 12, 11.1, 73, 4.3, 39, 2.5, 1.6),
      A = c(-7.3, 5.1 ,0.12, 15, 21, 1.2, -0,07, 4.3, 39, 2.5) 
      B = c(-18.9, 0.12, 15, 11.1, 73, -2, 4, 40, -19.5, 19.6)
      C = c(4.3, 39, 2.5, 1.6, -7.3, 6, 5.1 ,0.12, -0.07, 4.3)
    library(DT)
    datatable(df) %>% formatStyle(
      'A',
      target = 'cell',
      backgroundColor = styleInterval(3, c('green','pink')))
    %>% formatStyle(
      'B',
      target = 'cell',
      backgroundColor = styleInterval(3, c('green','pink'))
    )%>% formatStyle(
      'C',
      target = 'cell',
      backgroundColor = styleInterval(3, c('green','pink'))
    )

    colors <- with(df, ifelse(X > -4 & X < 4 & Y < 10, 
                              "pink", 
                              ifelse(Y > 10, 
                                     "blue", "white")))

    rgbcolors <- apply(grDevices::col2rgb(colors), 2, 
                       function(rgb) sprintf("rgb(%s)", paste(rgb, collapse=",")))
    columns <- c(2,3) # columns X and Y
    jscode <- 
      paste("function(row, data, index) {",  
            sprintf("var colors=%s;\n%s", 
                    sprintf("[%s]", 
                            paste(sprintf("'%s'", rgbcolors), collapse=", ")), 
                    paste(sprintf("$(this.api().cell(index, %s).node()).css('background-color', colors[index]);", 
                                  columns), collapse="\n")), 
            "}", sep="\n")
    datatable(df, escape=FALSE, 
              options = list(rowCallback=JS(jscode))
    )
    jscode <- "function(row, data, index) {
  var colors = ['rgb(255,192,203)', 'rgb(255,255,255)', 'rgb(0,0,255)', 'rgb(0,0,255)', 'rgb(0,0,255)', 'rgb(0,0,255)', 'rgb(255,192,203)', 'rgb(0,0,255)', 'rgb(255,255,255)', 'rgb(255,255,255)'];
  $(this.api().cell(index, 2).node()).css('background-color', colors[index]);
  $(this.api().cell(index, 3).node()).css('background-color', colors[index]);
}"

Thank you in advance

回答1:

The first solution I provided works fine but the code is unreadable. Here is a cleaner solution.

library(DT)
df <- data.frame(
  id = 1:10, 
  X = c(-2, 4, 40, -0.1228, 2.9, 9, 2.7, 2.7, 31, -30),
  Y = c(-18.9, -19.5, 19.6, 12, 11.1, 73, 4.3, 39, 2.5, 1.6),
  A = c(-7.3, 5.1 ,0.12, 15, 21, 1.2, -0,07, 4.3, 39),
  B = c(-18.9, 0.12, 15, 11.1, 73, -2, 4, 40, -19.5, 19.6),
  C = c(4.3, 39, 2.5, 1.6, -7.3, 6, 5.1 ,0.12, -0.07, 4.3)
)
jscode <- "function(settings) {
  var table = settings.oInstance.api();
  var nrows = table.rows().count();
  for(var i=0; i<nrows; i++){
    var cell1 = table.cell(i,2);
    var cell2 = table.cell(i,3);
    var X = cell1.data(); var Y = cell2.data();
    var bgcolor = 'white';
    if(X > -4 && X < 4 && Y < 10){
      bgcolor = 'pink';
    }else if(Y > 10){
      bgcolor = 'blue';
    }
    cell1.node().style.backgroundColor = bgcolor;
    cell2.node().style.backgroundColor = bgcolor;
  }
}"
datatable(df, escape=FALSE, 
          options = list(initComplete=JS(jscode))) %>% 
  formatStyle(
    'A',
    target = 'cell',
    backgroundColor = styleInterval(3, c('green','pink'))) %>% 
  formatStyle(
    'B',
    target = 'cell',
    backgroundColor = styleInterval(3, c('green','pink'))) %>% 
  formatStyle(
    'C',
    target = 'cell',
    backgroundColor = styleInterval(3, c('green','pink'))
  )

回答2:

Start with

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

and add the formatStyle's.

library(DT)
df <- data.frame(
  id = 1:10, 
  X = c(-2, 4, 40, -0.1228, 2.9, 9, 2.7, 2.7, 31, -30),
  Y = c(-18.9, -19.5, 19.6, 12, 11.1, 73, 4.3, 39, 2.5, 1.6),
  A = c(-7.3, 5.1 ,0.12, 15, 21, 1.2, -0,07, 4.3, 39),
  B = c(-18.9, 0.12, 15, 11.1, 73, -2, 4, 40, -19.5, 19.6),
  C = c(4.3, 39, 2.5, 1.6, -7.3, 6, 5.1 ,0.12, -0.07, 4.3)
)

colors <- with(df, ifelse(X > -4 & X < 4 & Y < 10, 
                          "pink", 
                          ifelse(Y > 10, 
                                 "blue", "white")))
rgbcolors <- apply(grDevices::col2rgb(colors), 2, 
                   function(rgb) sprintf("rgb(%s)", paste(rgb, collapse=",")))
columns <- c(2,3) # columns X and Y
jscode <- 
  paste("function(row, data, index) {",  
        sprintf("var colors=%s;\n%s", 
                sprintf("[%s]", 
                        paste(sprintf("'%s'", rgbcolors), collapse=", ")), 
                paste(sprintf("$(this.api().cell(index, %s).node()).css('background-color', colors[index]);", 
                              columns), collapse="\n")), 
        "}", sep="\n")

datatable(df, escape=FALSE, 
          options = list(rowCallback=JS(jscode))) %>% 
  formatStyle(
    'A',
    target = 'cell',
    backgroundColor = styleInterval(3, c('green','pink'))) %>% 
  formatStyle(
    'B',
    target = 'cell',
    backgroundColor = styleInterval(3, c('green','pink'))) %>% 
  formatStyle(
    'C',
    target = 'cell',
    backgroundColor = styleInterval(3, c('green','pink'))
  )