如何在R Shiny矩阵输入中实现百分比格式显示并保留数值计算？

问题背景与需求 #

现有一个包含3个关联输入矩阵的Shiny应用：

• base_input 是静态输入矩阵
• var_1_input 和 var_2_input（合称var_x_input）会响应base_input和时间滑块input$periods的输入，用户可修改左侧标注为“X”的时间维度列

需要实现以下要求：

1. 对base_input以及var_x_input的第二列（Y列），自动应用百分比格式，显示至少两位小数且不四舍五入；
2. 格式需在App启动、用户修改现有值、新增单元格时均生效；
3. 输入值的显示与数值处理规则：输入20显示20.00%并以0.20参与计算，输入212显示212.00%并以2.12参与计算，输入15.45显示15.45%并以0.1545参与计算，输入0.2显示0.20%并以0.002参与计算；
4. 保留原代码的响应逻辑（如base_input[1,1]变更仅重置var_1_input），确保数值可用于后续计算。

解决方案代码 #

library(shiny)
library(shinyMatrix)

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",
    customclass = "percent-input"
  )
}

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",
    customclass = c("time-input", "percent-input")
  )
}

ui <- fluidPage(
  tags$head(
    tags$script(HTML("
      // 格式化百分比输入框的核心函数
      function formatPercent(inputElement) {
        let rawValue = inputElement.value.trim();
        if (rawValue === '') return;
        
        let numValue = parseFloat(rawValue);
        if (isNaN(numValue)) return;
        
        // 前端显示：数值×100后保留两位小数+%
        inputElement.value = (numValue * 100).toFixed(2) + '%';
        // 存储原始数值到自定义属性，供Shiny读取计算
        inputElement.dataset.rawValue = numValue;
      }
      
      $(document).on('shiny:connected', function() {
        // 初始化已存在的百分比输入框
        $('.percent-input input').each(function() {
          formatPercent(this);
        });
        
        // 监听输入框失去焦点事件，触发格式化
        $(document).on('blur', '.percent-input input', function() {
          formatPercent(this);
          // 手动触发Shiny更新输入值
          Shiny.setInputValue(this.name, $(this).closest('.matrix-input').data('rawValue'), {priority: 'event'});
        });
        
        // 监听矩阵新增行/列操作，对新单元格应用格式化
        $(document).on('click', '.matrix-input .btn-add-row, .matrix-input .btn-add-col', function() {
          setTimeout(function() {
            $('.percent-input input').each(function() {
              if (!this.dataset.rawValue) {
                formatPercent(this);
              }
            });
          }, 100);
        });
      });
      
      // 自定义消息处理器：读取原始数值作为Shiny输入值
      Shiny.addCustomMessageHandler('getMatrixValue', function(id) {
        let matrix = [];
        $(`#${id} .matrix-input-row`).each(function() {
          let row = [];
          $(this).find('input').each(function() {
            if ($(this).closest('.percent-input').length) {
              row.push(parseFloat(this.dataset.rawValue) || 0);
            } else {
              row.push(parseFloat(this.value) || 0);
            }
          });
          matrix.push(row);
        });
        Shiny.setInputValue(id, matrix, {priority: 'event'});
      });
    "))
  ),
  sliderInput("periods", "时间窗口 (W):", min = 1, max = 10, value = 5),
  h5(strong("变量 (Y) 随窗口 (W) 变化:")),
  matInputBase("base_input"),
  uiOutput("Vectors"),
  h4("计算结果汇总"),
  textOutput("sumBaseInput"),
  textOutput("sumVar1Input"),
  textOutput("sumVar2Input")
)

server <- function(input, output, session) {
  prev_base_input <- reactiveValues(data = matrix(NA, nrow = 2, ncol = 1))
  
  # 保留原响应逻辑：base_input变更时更新对应var_x_input
  observeEvent(input$base_input, {
    for (i in 1:2) {
      if (is.na(prev_base_input$data[i, 1]) || input$base_input[i, 1] != prev_base_input$data[i, 1]) {
        updateMatrixInput(
          session,
          paste0("var_", i, "_input"),
          value = matrix(c(input$periods, input$base_input[i, 1]), 1, 2, dimnames = list(NULL, c("X", "Y")))
        )
        prev_base_input$data[i, 1] <- input$base_input[i, 1]
      }
    }
  }, ignoreInit = FALSE)
  
  # 渲染可变矩阵输入
  output$Vectors <- renderUI({
    varNames <- c("A", "B")
    lapply(1:2, function(i) {
      list(
        h5(strong(paste("调整", varNames[i], "(Y) 在时间点 X:"))),
        matInputVary(paste0("var_", i, "_input"), input$periods, isolate(input$base_input)[i, 1])
      )
    })
  })
  
  # 计算汇总值（直接使用转换后的小数数值）
  output$sumBaseInput <- renderText({
    paste("Base Input 总和:", sum(input$base_input[, 1]))
  })
  output$sumVar1Input <- renderText({
    paste("Var1 Input Y列总和:", sum(input$var_1_input[, 2]))
  })
  output$sumVar2Input <- renderText({
    paste("Var2 Input Y列总和:", sum(input$var_2_input[, 2]))
  })
  
  # 页面加载后初始化所有矩阵的数值读取
  observeEvent(session$clientData$url_hash, {
    session$sendCustomMessage("getMatrixValue", "base_input")
    session$sendCustomMessage("getMatrixValue", "var_1_input")
    session$sendCustomMessage("getMatrixValue", "var_2_input")
  }, ignoreInit = FALSE)
}

shinyApp(ui, server)

关键实现说明 #

1. 自定义类标记目标输入框：

   • 给base_input的所有输入框添加percent-input类
   • 给var_x_input的第二列（Y列）添加percent-input类，第一列（X列）保留time-input类区分时间维度

2. JavaScript处理显示与数值分离：

   • formatPercent函数实现显示格式与原始数值的分离：前端显示百分比格式，原始小数数值存储在输入框的自定义属性中
   • 监听blur事件确保用户输入完成后自动格式化，同时触发Shiny更新输入值
   • 监听矩阵扩展操作，对新增单元格自动应用格式化规则

3. 重写Shiny输入读取逻辑：

   • 通过自定义消息处理器getMatrixValue，读取存储的原始小数数值作为Shiny的输入值，确保计算使用正确的数值

4. 保留原有响应逻辑：

   • 原有的base_input变更响应逻辑完全保留，仅更新var_x_input的原始数值，格式化由前端自动处理
   • 汇总计算直接使用input$xxx中的小数数值，无需额外转换

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