r - 是否有任何类似的方法来对 Shiny 中的 excel 中的多列进行条件格式设置

Question

我有一个从 excel 上传并以 Shiny 的数据表显示的数据框，在 excel 中，我们使用条件格式根据单元格本身的值和其他单元格的值来更改单元格的颜色。因此，例如对于列 ID、X、Y，逻辑如下:

if -4 < X < 4 and Y < 10 X,Y 的颜色为粉红色

elseif Y >10 X,Y 颜色为蓝色

否则 X =""或 Y=""则 X,Y 的颜色为白色

我尝试使用 DT 包但没有成功，有人可以帮我解决这个问题或提出其他方法吗？先感谢您
这是我的代码，带有可重现的数据框。

ui <- shinyUI(fluidPage(
  titlePanel("Column Plot"),
  tabsetPanel(
    tabPanel("Upload File",
             titlePanel("Uploading Files"),
             sidebarLayout(
               sidebarPanel(
                 fileInput('file1', 'Choose xlsx file',
                           accept = c(".xlsx")
                 ),
                 tags$br(),
                 checkboxInput('header', 'Header', TRUE),
                 radioButtons('sep', 'Separator',
                              c(Comma=',',
                                Semicolon=';',
                                Tab='\t'),
                              ','),
                 radioButtons('quote', 'Quote',
                              c(None='',
                                'Double Quote'='"',
                                'Single Quote'="'"),
                              '"')

               ),
               mainPanel(
                 tableOutput('contents')
               )
             )
    ),
tabPanel("contents_extra",
             pageWithSidebar(
               headerPanel('contents_extra'),
               sidebarPanel(
                 checkboxInput('test', 'test', TRUE)

               ),
               mainPanel(
                 dataTableOutput('contents_extra')
               )
             )
    ),
output$contents_extra <- 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)
      options(DT.options = list(pageLength = 100))
      datatable(df, options = list(
      columnDefs = list(list(targets = X, visible = TRUE)))) %>% formatStyle(
      columns = c("X","Y"),
      valueColumns = c("X","Y"),
      backgroundColor = styleEqual(c(X > -4 && X < 4 && Y < 10, Y > 10, X ="" or Y=""), c('pink', 'bleu','white'))
       )
    })

Answer 1

这是一个关于 DT 的问题(无论你是否使用shiny，答案都是一样的)。

在 R 中导出颜色更容易。然后使用 rowCallback .

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

创建的Javascript代码是:

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