R Shiny表格实现最接近值标绿及各组最接近次数统计需求

要完成你要求的两项功能，需要改用DT包实现表格的自定义样式渲染，完整可运行代码如下：

library(shiny)
library(DT)

ui <- fluidPage(
    titlePanel("随机模拟对比测试"),
    sidebarLayout(
        sidebarPanel(
            actionButton("random_select",
                         "生成随机数",
                         width = 'auto')
        ),
        mainPanel(
           DTOutput("results_table_output")
        )
    )
)

server <- function(input, output) {
    counter <- reactiveValues(countervalue = 0)
    
    observeEvent(input$random_select,{
        counter$countervalue = counter$countervalue + 1
    })
    
    results <- reactiveValues(
        table = list(trial = NA,
                     answer =NA,
                     test_1 = NA,
                     test_2 = NA,
                     test_3 = NA)
    )
    
    observeEvent(counter$countervalue,{
        results$table$trial[counter$countervalue] <- as.integer(counter$countervalue)
        results$table$answer[counter$countervalue] <- sample(1:10,1)
        results$table$test_1[counter$countervalue] <- sample(1:10,1)
        results$table$test_2[counter$countervalue] <- sample(1:10,1)
        results$table$test_3[counter$countervalue] <- sample(1:10,1)
    })
    
    output$results_table_output <- renderDT({
        # 转换为数据框并过滤初始化空行
        df <- na.omit(as.data.frame(results$table))
        if(nrow(df) == 0) {
            return(datatable(df, rownames = FALSE, options = list(dom = 't', ordering = FALSE)))
        }
        
        # 逐行定位最接近答案的测试组
        best_col_per_row <- apply(df, 1, function(row_data) {
            test_vals <- as.numeric(row_data[c("test_1", "test_2", "test_3")])
            answer_val <- as.numeric(row_data["answer"])
            diff_vals <- abs(test_vals - answer_val)
            return(names(diff_vals)[which.min(diff_vals)])
        })
        
        # 统计各测试组累计最优次数
        count_test1 <- sum(best_col_per_row == "test_1")
        count_test2 <- sum(best_col_per_row == "test_2")
        count_test3 <- sum(best_col_per_row == "test_3")
        
        # 追加汇总行
        df <- rbind(df, data.frame(
            trial = "累计次数",
            answer = NA,
            test_1 = count_test1,
            test_2 = count_test2,
            test_3 = count_test3
        ))
        
        # 渲染表格并添加单元格样式
        dt <- datatable(df, rownames = FALSE, options = list(dom = 't', ordering = FALSE))
        # 为每行最优单元格设置绿色背景
        for (row_idx in seq_along(best_col_per_row)) {
            col_idx <- which(colnames(df) == best_col_per_row[row_idx])
            dt <- formatStyle(
                dt,
                columns = col_idx,
                target = 'cell',
                rows = row_idx,
                backgroundColor = "lightgreen"
            )
        }
        return(dt)
    })
}

shinyApp(ui = ui, server = server)

核心修改说明 #

• 替换原生表格渲染组件：将原有的tableOutput+renderTable替换为DT包的DTOutput+renderDT，支持自定义单元格样式
• 最优值定位逻辑：逐行计算三个测试组数值与正确答案的绝对差值，通过which.min定位差值最小的列，适配无平局的业务场景
• 汇总行实现：统计历史所有测试轮次中三个测试组分别成为最优值的总次数，在表格末尾追加一行展示统计结果
• 样式配置：关闭了默认的排序、搜索控件，仅保留基础表格展示，同时将最优单元格背景设置为浅绿色，可根据需要调整颜色值

内容的提问来源于stack exchange，提问作者Jake L