如何用CSS为R Shiny中动态用户输入矩阵添加背景色？

问题原因 #

动态矩阵var_1_input和var_2_input通过renderUI动态生成，原JS代码仅监听了初始连接与静态矩阵的变化，未覆盖动态元素的渲染及行扩展场景，同时选择器未包含动态矩阵的输入区域。

修改步骤 #

1. 扩展高亮函数，覆盖静态矩阵与所有动态矩阵的输入单元格
2. 补充事件监听，确保高亮在动态UI渲染、动态矩阵修改/扩展时生效
3. 优化CSS样式，让高亮效果覆盖完整单元格

修改后的完整代码 #

library(shinyMatrix)
library(shiny)
library(shinyjs)

matInputBase <- function(name) {
  matrixInput(
    name,
    value = matrix(rep(20,2),2, 1,dimnames = list(c("A", "B"), NULL)),
    rows = list(extend = FALSE, names = TRUE),
    cols = list(extend = FALSE, names = FALSE, editableNames = FALSE),
    class = "numeric"
  )
}

matInputVary <- function(name, x,y) {
  matrixInput(
    name,
    value = matrix(c(x, y), 1, 2, dimnames = list(NULL,c("X","Y"))),
    rows = list(extend = TRUE, names = FALSE),
    cols = list(extend = TRUE, delta = 0, names = TRUE, editableNames = FALSE),
    class = "numeric"
  )
}

ui <- fluidPage(
  useShinyjs(),
  # 优化高亮样式，确保覆盖完整单元格
  inlineCSS(list(".highlight" = "background-color: #ffcccc; padding: 4px;")),
  tags$head(
    tags$script(HTML("
      function applyHighlight() {
        // 清除已有高亮，避免重复叠加
        $('.highlight').removeClass('highlight');
        
        // 处理静态矩阵base_input：第2列为输入区域（第1列是行名）
        $('#base_input td:nth-child(2)').addClass('highlight');
        
        // 处理所有动态矩阵（ID以var_开头）：所有单元格都是输入区域
        $('[id^=\"var_\"] td').addClass('highlight');
      }
      
      // 应用启动连接后初始化高亮
      $(document).on('shiny:connected', function() {
        applyHighlight();
      });
      
      // 静态矩阵base_input修改后重新高亮
      $(document).on('shiny:inputchanged', function(event) {
        if (event.name === 'base_input') {
          setTimeout(applyHighlight, 10);
        }
        // 动态矩阵扩展行或修改值后重新高亮
        if (event.name.startsWith('var_')) {
          setTimeout(applyHighlight, 10);
        }
      });
      
      // 动态UI（Vectors）渲染完成后高亮
      $(document).on('shiny:rendered', function(event) {
        if (event.target.id === 'Vectors') {
          setTimeout(applyHighlight, 10);
        }
      });
    "))
  ),
  sliderInput("periods","Time window (W):", min = 1, max =10, value = 5),
  h5(strong("Variable (Y) over window (W):")),
  matInputBase("base_input"),
  uiOutput("Vectors")
)

server <- function(input, output, session) {
  output$Vectors <- renderUI({
    input$resetVectorBtn
    varNames <- c("A", "B")
      lapply(1:2, function(i) {
        list(
          h5(strong(paste("Adjust", varNames[i], "(Y) at time X:"))),
          matInputVary(paste0("var_", i, "_input"), input$periods, input$base_input[i, 1])
        )
      })
  })
}

shinyApp(ui, server)

关键修改说明 #

• 选择器适配：用[id^="var_"]匹配所有动态矩阵，确保新生成的var_1_input和var_2_input都被选中
• 事件覆盖：新增shiny:rendered监听动态UI加载完成，新增动态矩阵的shiny:inputchanged监听，处理行扩展后的新单元格
• 样式优化：调整CSS的padding，让背景色覆盖完整输入单元格

内容的提问来源于stack exchange，提问作者Village.Idyot