为何无放回抽样函数输出重复？PCA置换函数问题排查

问题原因 #

perm_fun1的核心逻辑是调换列的顺序：通过sample(1:ncol(DF), replace=F)生成列索引的随机排列，然后重新排列原矩阵的列。但PCA的方差解释率（PVE）仅由变量间的协方差结构决定，列的顺序调换不会改变协方差矩阵的本质，因此每次运行perm_fun1得到的PCA结果完全一致，最终out_smp1的每行值都重复。

而perm_fun2是对每一列内部的元素进行无放回抽样（打乱行顺序），这会直接改变每个变量的分布以及变量间的协关系，因此每次运行能生成不同的PVE结果，符合需求。

修复方法 #

修改perm_fun1，使其逻辑与perm_fun2一致：对矩阵的每一列单独进行内部元素的置换，而非调换列的顺序。

修复后的代码 #

# 生成测试数据
D1 <- matrix(runif(10*12, 0, 2), ncol=12)

# 修复后的perm_fun1
perm_fun1_fixed <- function(DF){
  # 对每一列内部的元素进行无放回抽样置换
  new_data <- apply(DF, 2, sample, replace = FALSE)
  # 运行PCA
  pc.perm.out <- prcomp(new_data, center=T, scale.=T)
  # 计算各主成分的方差解释率
  pve.perm <- (pc.perm.out$sdev^2/sum(pc.perm.out$sdev^2))
}

perm_fun2 <- function(DF){
  # 对每一列内部的元素进行无放回抽样置换
  new_data <- apply(DF, 2, sample)
  # 运行PCA
  pc.perm.out <- prcomp(new_data,center=T, scale.=T)
  # 计算各主成分的方差解释率
  pve.perm <- (pc.perm.out$sdev^2/sum(pc.perm.out$sdev^2))
}

# 测试运行
out_smp1_fixed <- sapply(1:5, function(i) perm_fun1_fixed(D1))
out_smp2 <- sapply(1:5, function(i) perm_fun2(D1))

补充说明 #

如果你的需求是通过置换破坏变量间的原有协关系（用于PCA的置换检验），核心是要打乱每个变量内部的观测值，而非简单调整列顺序。后者不会改变变量间的相关性结构，因此无法得到有效的置换结果。

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