R语言循环实现配对置换t检验的配对标签置换方法咨询

你的核心置换规则是：仅允许在participant+gene定义的单个配对单元内部交换before/after标签，每个单元必须固定保留1个before和1个after样本，禁止跨单元打乱标签。

核心实现思路 #

先给每个独立配对单元分配唯一ID，所有置换操作仅在单元内执行：每个单元只有两种选择——保持原标签顺序、交换两个样本的标签，从根源上避免出现同单元标签重复的问题。 #

代码实现 #

1. 预处理：生成配对单元ID #

# base R 实现，无需额外包
df$pair_id <- as.integer(as.factor(paste(df$participant, df$gene, sep = "_")))
n_pairs <- length(unique(df$pair_id))

注意：你的示例数据共包含2个受试者、3个基因，总计6个独立配对单元。

2. 精确置换检验：遍历所有合法置换 #

当配对单元总数小于20时，可以遍历所有可能的置换组合（总组合数为2^n_pairs），得到精确的置换检验p值：

# 生成所有置换组合：每一列对应1个配对单元，0=不交换，1=交换
all_perm <- expand.grid(rep(list(c(0, 1)), n_pairs))
perm_results <- list()

for (i in 1:nrow(all_perm)) {
  perm_df <- df
  # 逐单元执行交换操作
  for (p in 1:n_pairs) {
    pair_rows <- which(perm_df$pair_id == p)
    if (all_perm[i, p] == 1) {
      # 翻转单元内两个样本的标签顺序
      perm_df$label[pair_rows] <- perm_df$label[rev(pair_rows)]
    }
  }
  # 在此处插入你的标准化、配对t检验流程
  # 示例：按基因分组计算配对t检验的t值
  t_stats <- sapply(split(perm_df, perm_df$gene), function(sub) {
    t.test(exp ~ label, paired = TRUE, data = sub)$statistic
  })
  perm_results[[i]] <- t_stats
}

# 合并所有置换结果
perm_results <- do.call(rbind, perm_results)

3. 近似置换检验：随机抽取合法置换 #

如果配对单元数量较多（>20），遍历所有组合计算量过大，可以随机抽取指定数量的合法置换完成检验：

n_perm <- 1000 # 自定义置换次数
perm_results <- list()

for (i in 1:n_perm) {
  perm_df <- df
  # 每个单元随机决定是否交换标签
  swap_logi <- sample(c(TRUE, FALSE), size = n_pairs, replace = TRUE)
  for (p in 1:n_pairs) {
    pair_rows <- which(perm_df$pair_id == p)
    if (swap_logi[p]) {
      perm_df$label[pair_rows] <- perm_df$label[rev(pair_rows)]
    }
  }
  # 在此处插入你的标准化、配对t检验流程
  t_stats <- sapply(split(perm_df, perm_df$gene), function(sub) {
    t.test(exp ~ label, paired = TRUE, data = sub)$statistic
  })
  perm_results[[i]] <- t_stats
}

perm_results <- do.call(rbind, perm_results)

原有代码的问题 #

你之前使用的sample(c("Before","After"), size = length(df$label), replace = TRUE)是无约束完全随机抽样，没有绑定配对单元，本质是破坏了配对设计，自然会出现同一配对单元下两个样本标签相同的错误。

小提示：原数据的标签是小写before/after，你之前的代码中使用了大写开头的Before/After，实际运行时注意大小写匹配，避免因子水平报错。

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