feat(ssa): Complete Phase 2A frontend integration - multi-step workflow end-to-end

Phase 2A: WorkflowPlannerService, WorkflowExecutorService, Python data quality, 6 bug fixes, DescriptiveResultView, multi-step R code/Word export, MVP UI reuse. V11 UI: Gemini-style, multi-task, single-page scroll, Word export. Architecture: Block-based rendering consensus (4 block types). New R tools: chi_square, correlation, descriptive, logistic_binary, mann_whitney, t_test_paired. Docs: dev summary, block-based plan, status updates, task list v2.0. Co-authored-by: Cursor <cursoragent@cursor.com>
2026-02-20 23:09:27 +08:00
parent 23b422f758
commit 428a22adf2
62 changed files with 15416 additions and 299 deletions
--- a/r-statistics-service/tools/correlation.R
+++ b/r-statistics-service/tools/correlation.R
@@ -0,0 +1,242 @@
+#' @tool_code ST_CORRELATION
+#' @name 相关分析
+#' @version 1.0.0
+#' @description Pearson/Spearman 相关系数计算
+#' @author SSA-Pro Team
+
+library(glue)
+library(ggplot2)
+library(base64enc)
+
+run_analysis <- function(input) {
+  # ===== 初始化 =====
+  logs <- c()
+  log_add <- function(msg) { logs <<- c(logs, paste0("[", Sys.time(), "] ", msg)) }
+  
+  on.exit({}, add = TRUE)
+  
+  # ===== 数据加载 =====
+  log_add("开始加载输入数据")
+  df <- tryCatch(
+    load_input_data(input),
+    error = function(e) {
+      log_add(paste("数据加载失败:", e$message))
+      return(NULL)
+    }
+  )
+  
+  if (is.null(df)) {
+    return(make_error(ERROR_CODES$E100_INTERNAL_ERROR, details = "数据加载失败"))
+  }
+  log_add(glue("数据加载成功: {nrow(df)} 行, {ncol(df)} 列"))
+  
+  p <- input$params
+  guardrails_cfg <- input$guardrails
+  
+  var_x <- p$var_x
+  var_y <- p$var_y
+  method <- tolower(p$method %||% "auto")  # pearson, spearman, auto
+  
+  # ===== 参数校验 =====
+  if (!(var_x %in% names(df))) {
+    return(make_error(ERROR_CODES$E001_COLUMN_NOT_FOUND, col = var_x))
+  }
+  if (!(var_y %in% names(df))) {
+    return(make_error(ERROR_CODES$E001_COLUMN_NOT_FOUND, col = var_y))
+  }
+  
+  # ===== 数据清洗 =====
+  original_rows <- nrow(df)
+  df <- df[!is.na(df[[var_x]]) & !is.na(df[[var_y]]), ]
+  
+  removed_rows <- original_rows - nrow(df)
+  if (removed_rows > 0) {
+    log_add(glue("数据清洗: 移除 {removed_rows} 行缺失值 (剩余 {nrow(df)} 行)"))
+  }
+  
+  x_vals <- df[[var_x]]
+  y_vals <- df[[var_y]]
+  n <- length(x_vals)
+  
+  # ===== 护栏检查 =====
+  guardrail_results <- list()
+  warnings_list <- c()
+  
+  # 样本量检查
+  sample_check <- check_sample_size(n, min_required = 10, action = ACTION_WARN)
+  guardrail_results <- c(guardrail_results, list(sample_check))
+  log_add(glue("样本量检查: N = {n}, {sample_check$reason}"))
+  
+  guardrail_status <- run_guardrail_chain(guardrail_results)
+  
+  if (guardrail_status$status == "blocked") {
+    return(list(
+      status = "blocked",
+      message = guardrail_status$reason,
+      trace_log = logs
+    ))
+  }
+  
+  if (length(guardrail_status$warnings) > 0) {
+    warnings_list <- c(warnings_list, guardrail_status$warnings)
+  }
+  
+  # ===== 方法选择 =====
+  final_method <- method
+  
+  if (method == "auto") {
+    log_add("自动选择相关方法（检验正态性）")
+    
+    # 检验两个变量的正态性
+    norm_x <- check_normality(x_vals, alpha = 0.05)
+    norm_y <- check_normality(y_vals, alpha = 0.05)
+    
+    log_add(glue("{var_x} 正态性: p = {round(norm_x$p_value, 4)}, {norm_x$reason}"))
+    log_add(glue("{var_y} 正态性: p = {round(norm_y$p_value, 4)}, {norm_y$reason}"))
+    
+    if (norm_x$passed && norm_y$passed) {
+      final_method <- "pearson"
+      log_add("两变量均满足正态性，使用 Pearson 相关")
+    } else {
+      final_method <- "spearman"
+      log_add("存在非正态变量，使用 Spearman 秩相关")
+      warnings_list <- c(warnings_list, "变量不满足正态性，自动切换为 Spearman 秩相关")
+    }
+  }
+  
+  # ===== 核心计算 =====
+  log_add(glue("执行 {final_method} 相关分析"))
+  
+  result <- cor.test(x_vals, y_vals, method = final_method)
+  
+  r_value <- result$estimate
+  p_value <- result$p.value
+  
+  # 相关系数解释
+  r_abs <- abs(r_value)
+  r_interpretation <- if (r_abs < 0.1) "可忽略" else if (r_abs < 0.3) "弱" else if (r_abs < 0.5) "中等" else if (r_abs < 0.7) "较强" else "强"
+  
+  log_add(glue("r = {round(r_value, 4)}, p = {round(p_value, 4)}, 相关强度: {r_interpretation}"))
+  
+  # ===== 生成图表 =====
+  log_add("生成散点图")
+  plot_base64 <- tryCatch({
+    generate_scatter_plot(df, var_x, var_y, r_value, p_value, final_method)
+  }, error = function(e) {
+    log_add(paste("图表生成失败:", e$message))
+    NULL
+  })
+  
+  # ===== 生成可复现代码 =====
+  original_filename <- if (!is.null(input$original_filename) && nchar(input$original_filename) > 0) {
+    input$original_filename
+  } else {
+    "data.csv"
+  }
+  
+  reproducible_code <- glue('
+# SSA-Pro 自动生成代码
+# 工具: 相关分析
+# 时间: {Sys.time()}
+# ================================
+
+library(ggplot2)
+
+# 数据准备
+df <- read.csv("{original_filename}")
+var_x <- "{var_x}"
+var_y <- "{var_y}"
+
+# 数据清洗
+df <- df[!is.na(df[[var_x]]) & !is.na(df[[var_y]]), ]
+
+# {final_method} 相关分析
+result <- cor.test(df[[var_x]], df[[var_y]], method = "{final_method}")
+print(result)
+
+# 可视化
+ggplot(df, aes(x = .data[[var_x]], y = .data[[var_y]])) +
+  geom_point(alpha = 0.6) +
+  geom_smooth(method = "lm", se = TRUE, color = "#3b82f6") +
+  theme_minimal() +
+  labs(title = paste("Correlation:", var_x, "vs", var_y),
+       subtitle = paste("r =", round(result$estimate, 3), ", p =", round(result$p.value, 4)))
+')
+  
+  # ===== 返回结果 =====
+  log_add("分析完成")
+  
+  output_results <- list(
+    method = if (final_method == "pearson") "Pearson product-moment correlation" else "Spearman's rank correlation rho",
+    method_code = final_method,
+    statistic = jsonlite::unbox(round(as.numeric(r_value), 4)),
+    p_value = jsonlite::unbox(as.numeric(p_value)),
+    p_value_fmt = format_p_value(p_value),
+    interpretation = r_interpretation,
+    n = n,
+    variables = list(x = var_x, y = var_y),
+    descriptive = list(
+      x = list(
+        variable = var_x,
+        mean = round(mean(x_vals), 3),
+        sd = round(sd(x_vals), 3),
+        median = round(median(x_vals), 3)
+      ),
+      y = list(
+        variable = var_y,
+        mean = round(mean(y_vals), 3),
+        sd = round(sd(y_vals), 3),
+        median = round(median(y_vals), 3)
+      )
+    )
+  )
+  
+  # Pearson 相关有置信区间
+  if (final_method == "pearson" && !is.null(result$conf.int)) {
+    output_results$conf_int <- as.numeric(result$conf.int)
+  }
+  
+  return(list(
+    status = "success",
+    message = "分析完成",
+    warnings = if (length(warnings_list) > 0) warnings_list else NULL,
+    results = output_results,
+    plots = if (!is.null(plot_base64)) list(plot_base64) else list(),
+    trace_log = logs,
+    reproducible_code = as.character(reproducible_code)
+  ))
+}
+
+# 辅助函数：生成散点图
+generate_scatter_plot <- function(df, var_x, var_y, r_value, p_value, method) {
+  # 限制点数防止图表过大
+  if (nrow(df) > 1000) {
+    set.seed(42)
+    df <- df[sample(nrow(df), 1000), ]
+  }
+  
+  p <- ggplot(df, aes(x = .data[[var_x]], y = .data[[var_y]])) +
+    geom_point(alpha = 0.5, color = "#64748b", size = 2) +
+    geom_smooth(method = "lm", se = TRUE, color = "#3b82f6", fill = "#93c5fd") +
+    theme_minimal() +
+    labs(
+      title = paste("Correlation:", var_x, "vs", var_y),
+      subtitle = paste0(
+        ifelse(method == "pearson", "Pearson ", "Spearman "),
+        "r = ", round(r_value, 3), 
+        ", p ", format_p_value(p_value)
+      ),
+      x = var_x,
+      y = var_y
+    )
+  
+  tmp_file <- tempfile(fileext = ".png")
+  ggsave(tmp_file, p, width = 6, height = 5, dpi = 100)
+  base64_str <- base64encode(tmp_file)
+  unlink(tmp_file)
+  
+  return(paste0("data:image/png;base64,", base64_str))
+}
+
+# 辅助：空值合并运算符
+`%||%` <- function(a, b) if (is.null(a)) b else a