根据 DataTableOutput 中的标志突出显示特定单元格

Question

我想突出显示 DataTableOutput 中的特定单元格（不是整个列或行），其中数据以宽格式显示，其中来自标志的信息以长格式显示。 我尝试使用相应的矩阵（具有 TRUE/FALSE 值）和 JS 回调来实现此目的，但被卡住了。我也尝试在 stackoverflow 上找到类似的方法，但不幸的是没有成功。

这是迄今为止我的代码：

library(shiny)
library(DT)
library(dplyr)
library(jsonlite)

# Sample long_data
long_data <- data.frame(
  id = rep(1:7, each = 10),
  year = rep(2011:2020, times = 7),
  value = rnorm(70),  # Example values
  flag = sample(c(TRUE, FALSE), 70, replace = TRUE)  # Example flag values
)

# Convert to wide format
wide_data <- reshape(long_data %>% select(-flag), idvar = "id", timevar = "year", direction = "wide")

# Create a matrix for flags
flag_matrix <- matrix(long_data$flag, nrow = 7, byrow = TRUE)
colnames(flag_matrix) <- paste0("value.", 2011:2020)  # Ensure these match wide_data column names
flag_matrix <- cbind(FALSE, flag_matrix)  # Adding an extra FALSE column to align with wide_data

ui <- fluidPage(
  # Include the flag matrix as a JavaScript variable
  tags$script(HTML(paste0("var flag_matrix = ", jsonlite::toJSON(flag_matrix, array = TRUE), ";"))),
  
  DTOutput("table")
)

server <- function(input, output, session) {
  output$table <- renderDT({
    datatable(wide_data,
              options = list(
                pageLength = 5, autoWidth = TRUE
              ), callback = JS(
                'function(settings, json) {
        var api = this.api();
        api.cells().every(function(){
          var cell = this;
          var rowIdx = cell.index().row;
          var colIdx = cell.index().column;

          // Check flag for the current cell
          if (flag_matrix[rowIdx][colIdx]) {
            $(cell.node()).css({"background-color": "lightblue", "font-weight": "bold"});
          }
        });
      }'
              )
    )
  })
}

shinyApp(ui, server)

不幸的是，此回调没有得到任何输出

Answer 1

你快明白了！

function(settings, json){ ... }

是

initComplete

选项，而不是

callback

。

library(shiny)
library(DT)
library(dplyr)
library(jsonlite)

# Sample long_data
long_data <- data.frame(
  id = rep(1:7, each = 10),
  year = rep(2011:2020, times = 7),
  value = rnorm(70),  # Example values
  flag = sample(c(TRUE, FALSE), 70, replace = TRUE)  # Example flag values
)

# Convert to wide format
wide_data <- reshape(long_data %>% select(-flag), idvar = "id", timevar = "year", direction = "wide")

# Create a matrix for flags
flag_matrix <- matrix(long_data$flag, nrow = 7, byrow = TRUE)
colnames(flag_matrix) <- paste0("value.", 2011:2020)  # Ensure these match wide_data column names
flag_matrix <- cbind(FALSE, flag_matrix)  # Adding an extra FALSE column to align with wide_data

ui <- fluidPage(
  # Include the flag matrix as a JavaScript variable
  tags$script(HTML(paste0("var flag_matrix = ", jsonlite::toJSON(flag_matrix, array = TRUE), ";"))),
  
  DTOutput("table")
)

server <- function(input, output, session) {
  output$table <- renderDT({
    datatable(
      wide_data,
      options = list(
        pageLength = 5, 
        autoWidth = TRUE,
        initComplete = JS(
          'function(settings, json) {
        var api = this.api();
        api.cells().every(function(){
          var cell = this;
          var rowIdx = cell.index().row;
          var colIdx = cell.index().column;

          // Check flag for the current cell
          if (flag_matrix[rowIdx][colIdx]) {
            $(cell.node()).css({"background-color": "lightblue", "font-weight": "bold"});
          }
        });
      }'
        )
      )
    )
  })
}

shinyApp(ui, server)