Question

这与此Is there any similar approach to conditional formating for multiple columns from excel in Shiny中的问题有关，所提供的解决方案可以正常工作，但是在如何扩展代码以满足新要求方面我有些栈。因此，如果我具有以下数据框，并希望根据以下条件更改五列的背景色：

对于X，Y列
如果-4
elseif Y> X，Y的10个颜色是蓝色
否则X =“”或Y =“”，则X，Y的颜色为白色
对于A，B，C列
如果“ A” <3，则“ A”为绿色，否则为粉红色
如果“ B” <3，则“ B”为绿色，否则为粉红色
如果“ C” <3，则“ C”为绿色，否则为粉红色

我试图在此处扩展提供的解决方案，但没有成功。谁能帮助您解决这个问题。

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]);
}"

提前谢谢

Answer 1

以

开头

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

并添加formatStyle。

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

Answer 2

我提供的第一个解决方案可以正常工作，但是代码不可读。这是一个更清洁的解决方案。

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

使用DT格式化列的单个/多个条件

2 个答案: