DT 柱有条件着色为闪亮

Question

我需要使用以下规则有条件地为“权重”列的背景着色：非负值是绿色，负值是红色，但如果没有正值，则 0 也应该是红色。我已经尝试了多种方法，但在我看来，条件

formatStyle

不起作用，至少在这种格式下：

ui <- fluidPage(
  DT::dataTableOutput("weight_df")
)

server <- function(input, output, session){
  
  df <- data.frame(weight = rep(1, 3))
  
  rv <- reactiveValues(weight_df = df)
  
  output$weight_df <- renderDataTable({
    
    DT::datatable(
      data = df,
      caption  = htmltools::tags$caption("Weight table"),
      editable = list(target = "column"),
    ) %>%
      formatStyle(
        "weight", 
        fontWeight = "bold",
        backgroundColor = `if`(
          all(df[["weight"]] <= 0),
          "orangered",
          styleInterval(-10^(-32), c("orangered", "limegreen"))
        )
      ) 
  })
  table_proxy <- DT::dataTableProxy("weight_df")
  
  observeEvent(input$weight_df_cell_edit, {
    
    info <- input$weight_df_cell_edit

    new_weights <- info[["value"]]
    is_numeric <- checkmate::testNumeric(
      x = new_weights,
      finite = TRUE,
      any.missing = FALSE
    )
    
    if(is_numeric)
      rv$weight_df[["weight"]][info[["row"]]] <- info[["value"]]
    
    DT::replaceData(table_proxy, rv$weight_df)
  })
}

shinyApp(ui, server)

注意：无需再次渲染表格。如果所有权重都为 0，我可以让它再次渲染。

Answer 1

我认为这是不可能的

formatStyle

。这是部分解决方案。它是部分的，因为它不处理 0 的情况，当没有值是正数时，0 必须是红色的。我会考虑一下。

library(shiny)
library(DT)

js <- c(
  "function(row, dat, displayNum, index){",
  "  var color = dat[1] >= 0 ? 'green' : 'red';",
  "  $('td:eq(1)', row).css('background-color', color);",
  "}"
)

ui <- fluidPage(
  br(),
  DTOutput("weight_df")
)

server <- function(input, output, session){
  
  df <- data.frame(weight = c(-1, 0, 2))
  
  rdf <- reactiveVal(df)
  
  output$weight_df <- renderDT({
    
    datatable(
      data = df,
      rownames = TRUE,
      caption  = htmltools::tags$caption("Weight table"),
      editable = list(target = "cell"),
      options = list(
        rowCallback = JS(js)
      )
    ) 
  })
  
  table_proxy <- dataTableProxy("weight_df")
  
  observeEvent(input$weight_df_cell_edit, {
    info <- input$weight_df_cell_edit
    dat <- rdf()
    rdf(editData(dat, info, table_proxy, rownames = TRUE))
  })
}

shinyApp(ui, server)