如何在含1000列的大数据框中高效运行Fisher检验？

你的核心问题是1000列两两组合的检验量太大（共499500次），加上部分integer列可能是连续值导致交叉表规模爆炸，直接跑单线程代码会耗尽资源甚至崩溃。以下是分步优化方案：

第一步：预处理数据，只保留适合Fisher检验的列 #

Fisher检验仅适用于分类变量，连续型integer列必须先离散化，否则会生成巨量交叉表，计算量陡增：

1. 筛选分类列 #

先识别哪些列是真正的分类变量：

# 判断列是否为分类变量：character类型，或水平数占比极低的integer类型
is_categorical <- function(col) {
  if (is.character(col)) return(TRUE)
  if (is.integer(col)) {
    # 水平数占行数比例<10%视为分类（可根据数据调整阈值）
    length(unique(col)) / length(col) < 0.1
  } else {
    FALSE
  }
}

# 筛选出符合条件的列
cat_cols <- colnames(MIBCMETAdf)[sapply(MIBCMETAdf, is_categorical)]

2. 离散化连续integer列 #

对不符合分类条件的连续integer列进行分箱处理（比如分位数分箱）：

# 分箱函数：将连续列转为5个分位数区间的因子
discretize_col <- function(col, n_bins = 5) {
  cut(col, breaks = quantile(col, probs = seq(0, 1, 1/n_bins)), include.lowest = TRUE)
}

# 处理数据框，替换连续integer列
MIBCMETAdf_processed <- MIBCMETAdf
for (col in setdiff(colnames(MIBCMETAdf), cat_cols)) {
  if (is.integer(MIBCMETAdf[[col]])) {
    MIBCMETAdf_processed[[col]] <- discretize_col(MIBCMETAdf[[col]])
  }
}

# 更新分类列列表
cat_cols <- colnames(MIBCMETAdf_processed)[sapply(MIBCMETAdf_processed, is_categorical)]

第二步：用并行计算加速检验 #

单线程跑近50万次检验效率极低，用多线程并行计算可以大幅缩短时间：

1. 生成列组合（用list存储更高效） #

com <- combn(cat_cols, 2, simplify = FALSE)

2. 并行运行检验 #

使用future.apply包实现多线程，同时加入错误处理和性能优化（比如大样本用卡方检验近似）：

library(future.apply)
# 开启多线程，默认使用所有可用CPU核心
plan(multisession)

# 定义单个检验的逻辑
run_fisher <- function(col_pair) {
  col1 <- MIBCMETAdf_processed[[col_pair[1]]]
  col2 <- MIBCMETAdf_processed[[col_pair[2]]]
  
  # 跳过水平数不足2的列
  if (length(unique(col1)) < 2 || length(unique(col2)) < 2) {
    return(list(p.value = NA, estimate = NA, error = "Insufficient levels"))
  }
  
  tab <- table(col1, col2)
  # 小样本/有零单元格用Fisher检验，大样本用卡方检验（更快）
  if (any(tab == 0) && sum(tab) < 100) {
    res <- tryCatch(fisher.test(tab), error = function(e) e)
  } else {
    res <- tryCatch(chisq.test(tab), error = function(e) e)
  }
  
  # 整理结果
  if (inherits(res, "error")) {
    list(p.value = NA, estimate = NA, error = res$message)
  } else {
    list(p.value = res$p.value, 
         estimate = if (!is.null(res$estimate)) res$estimate else NA, 
         error = NA)
  }
}

# 并行执行所有检验
fisher_results <- future_lapply(com, run_fisher, future.seed = TRUE)

第三步：整理结果并校正多重检验 #

近50万次检验必须做多重检验校正，否则假阳性结果会非常多：

# 将结果转为数据框
E_table <- data.frame(
  col1 = sapply(com, `[`, 1),
  col2 = sapply(com, `[`, 2),
  p.value = sapply(fisher_results, `[[`, "p.value"),
  estimate = sapply(fisher_results, `[[`, "estimate"),
  error = sapply(fisher_results, `[[`, "error"),
  stringsAsFactors = FALSE
)

# 加入FDR校正后的p值
E_table$adj_p <- p.adjust(E_table$p.value, method = "fdr")

# 查看结果
head(E_table)

额外优化建议 #

• 排除高基数列：如果某列水平数超过20，交叉表规模会非常大，建议合并水平或直接排除这类列
• 分批处理：如果内存不足，可以将列组合分成若干批次，计算一批写入一批文件
• 先做快速筛选：先用互信息、卡方值等快速度量筛选出可能关联的列对，再针对这些对做Fisher检验，减少计算量

内容的提问来源于stack exchange，提问作者Hi Ra