如何生成预设列间平均相关性的同向量多组抽样样本？

问题背景 #

我需要从同一向量中抽取多组样本，目标是生成不同参数下的行和最大值分布。当前的实现代码如下：

# set seed
set.seed(24601) 

# generate vector of values
values <- c(1:10)

# create five different configurations of these values
configuration <- 
  replicate(5,
           sample(values, 10))

# what's the maximum rowsum?
max(rowSums(configuration))

但我希望在生成样本时能预先设定列之间的平均相关性，即让以下代码的结果符合预期值：

mean(cor(configuration)[lower.tri(cor(configuration))])

现有资料大多针对随机变量生成，找不到适用于sample()这类随机抽样场景的方案，相当于寻求sample()对应的rnorm_multi等效工具。

补充：有人提出可以先生成大量样本再筛选符合相关性要求的子集，比如：

configuration_large <- 
  replicate(1000,
          sample(values, 10))

然后保留平均相关性在0.3-0.4之间的列，但这种方法在大样本场景（比如抽样50次且要求相关性≥0.3）中完全不现实。

解决方案思路 #

方法1：基于秩相关的约束抽样 #

因为我们处理的是离散值的无放回抽样（本质是生成1-10的排列），可以利用秩相关的特性构造相关排列：交换基准排列的元素对越少，新排列与基准的相关性越高；交换越多，相关性越低。

示例代码：

set.seed(24601)
values <- 1:10
n_cols <- 5
target_mean_cor <- 0.3

# 生成基准排列
base_perm <- sample(values)
configuration <- matrix(base_perm, ncol=1)

# 定义交换函数：交换k对元素生成相关排列
generate_correlated_perm <- function(base, k) {
  perm <- base
  for (i in 1:k) {
    idx <- sample(length(base), 2)
    perm[idx] <- perm[rev(idx)]
  }
  return(perm)
}

# 迭代生成后续列，微调交换次数逼近目标相关性
current_cors <- c()
for (i in 2:n_cols) {
  # 初始交换次数，基于目标相关性估算
  k <- round((1 - target_mean_cor) * length(values))
  perm <- generate_correlated_perm(base_perm, k)
  cors <- cor(configuration, perm)
  current_cors <- c(current_cors, cors)
  
  # 动态调整交换次数，控制相关性在目标区间内
  while(mean(current_cors) < target_mean_cor - 0.05 || mean(current_cors) > target_mean_cor + 0.05) {
    if(mean(current_cors) < target_mean_cor) {
      k <- max(k - 1, 0) # 减少交换，提升相关性
    } else {
      k <- k + 1 # 增加交换，降低相关性
    }
    perm <- generate_correlated_perm(base_perm, k)
    cors <- cor(configuration, perm)
    current_cors <- c(current_cors[-length(current_cors)], cors)
  }
  configuration <- cbind(configuration, perm)
}

# 验证平均相关性
mean(cor(configuration)[lower.tri(cor(configuration))])
max(rowSums(configuration))

方法2：使用Copula构造相关排列 #

利用Copula生成带指定相关性的多元均匀样本，再通过秩转换得到排列，能更精准控制整体相关性结构：

示例代码：

set.seed(24601)
values <- 1:10
n_cols <- 5
target_mean_cor <- 0.3

# 构造目标相关矩阵，对角线为1，其余为目标平均相关性
cor_mat <- matrix(target_mean_cor, nrow=n_cols, ncol=n_cols)
diag(cor_mat) <- 1

# 用正态Copula生成相关均匀样本
library(copula)
norm_cop <- normalCopula(param = cor_mat, dim = n_cols, dispstr = "un")
u <- rCopula(length(values), norm_cop)

# 将均匀样本转换为排列：每行的秩对应元素在values中的位置
configuration <- t(apply(u, 1, function(x) values[rank(x)]))

# 验证平均相关性
mean(cor(configuration)[lower.tri(cor(configuration))])
max(rowSums(configuration))

方案说明 #

• 方法1无需额外依赖包，逻辑直观，适合小维度场景；需微调交换次数来精准匹配目标相关性。
• 方法2基于Copula理论，能更稳定地控制整体相关性结构，适合大维度场景，但需要安装copula包。

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