如何基于单元格值计算几何均值？Shiny应用实现需求

需求说明 #

• table 2第1行应为table 1第1行与第3行的几何均值
• table 2第2行应为table 1第2行与第4行的几何均值

完整代码 #

library(shiny)
library(shinydashboard)
library(rhandsontable)
library(data.table)
library(dplyr)

# 初始化数据
df1 <- data.table(column1 = as.numeric(c(3, 8, 3, 8)))
df2 <- data.table(column2 = as.numeric(c(0, 0)))

ui <- dashboardPage(
  dashboardHeader(title = "Geometric Mean Calculation"),
  dashboardSidebar(
    menuItem("Calculation", tabName = "calculation",
             menuSubItem("Gmean", tabName = "table1"))
  ),
  dashboardBody(
    tabItems(
      tabItem(
        tabName = "table1",
        column(
          width = 6,
          h4("table 1"),
          rHandsontableOutput("Table1")
        ),
        column(
          width = 6,
          h4("table 2"),
          rHandsontableOutput("Table2")
        )
      )
    )
  )
)

server = function(input, output) {
  
  data <- reactiveValues()
  
  # 初始化数据
  observe({
    data$DF1 <- as.data.frame(df1)
    data$DF2 <- as.data.frame(df2)
  })
  
  # 监听table1的修改，更新数据并确保数值类型
  observe({
    if(!is.null(input$Table1)){
      data$DF1 <- hot_to_r(input$Table1)
      data$DF1$column1 <- as.numeric(data$DF1$column1)
    }
  })
  
  # 实时计算并更新table2的几何均值
  observe({
    req(data$DF1)
    # 计算第1个几何均值：第1行和第3行
    if(all(!is.na(data$DF1$column1[c(1,3)])) && all(data$DF1$column1[c(1,3)] > 0)){
      data$DF2$column2[1] <- sqrt(data$DF1$column1[1] * data$DF1$column1[3])
    } else {
      data$DF2$column2[1] <- NA  # 无效输入时显示NA
    }
    # 计算第2个几何均值：第2行和第4行
    if(all(!is.na(data$DF1$column1[c(2,4)])) && all(data$DF1$column1[c(2,4)] > 0)){
      data$DF2$column2[2] <- sqrt(data$DF1$column1[2] * data$DF1$column1[4])
    } else {
      data$DF2$column2[2] <- NA  # 无效输入时显示NA
    }
  })
  
  # 渲染table1，支持数值输入
  output$Table1 <- renderRHandsontable({
    rhandsontable(data$DF1, rowHeaders = FALSE) %>%
      hot_col("column1", type = "numeric", format = "0.00")
  })
  
  # 渲染table2，设置为只读避免手动修改
  output$Table2 <- renderRHandsontable({
    rhandsontable(data$DF2, rowHeaders = FALSE, readOnly = TRUE) %>%
      hot_col("column2", type = "numeric", format = "0.00")
  })
  
}

shinyApp(ui, server)

代码优化说明 #

• 给表格添加标题，布局更清晰
• 增加输入验证：仅当table1对应行是正数且非空时才计算几何均值，无效输入时显示NA
• 将table2设为只读，防止手动修改计算结果
• 统一数值显示格式为两位小数，提升可读性

内容的提问来源于stack exchange，提问作者firuz.safaev