基于列组的列随机抽样

Question

我有一个简单的问题可以用肮脏的方式解决，但我正在寻找使用data.table的干净方式

我有以下 data.table 和 n 列属于 m 个不相等的组。这是我的 data.table 的示例：

dframe   <- as.data.frame(matrix(rnorm(60), ncol=30))
cletters <- rep(c("A","B","C"), times=c(10,14,6))
colnames(dframe) <- cletters


           A           A          A           A           A          A
1 -0.7431185 -0.06356047 -0.2247782 -0.15423889 -0.03894069  0.1165187
2 -1.5891905 -0.44468389 -0.1186977  0.02270782 -0.64950716 -0.6844163
          A         A          A          A         B         B          B
1 -1.277307 1.8164195 -0.3957006 -0.6489105 0.3498384 -0.463272  0.8458673
2 -1.644389 0.6360258  0.5612634  0.3559574 1.9658743  1.858222 -1.4502839
           B          B          B         B          B           B          B
1  0.3167216 -0.2919079  0.5146733 0.6628149  0.5481958 -0.01721261 -0.5986918
2 -0.8104386  1.2335948 -0.6837159 0.4735597 -0.4686109  0.02647807  0.6389771
           B          B           B          B          C           C
1 -1.2980799  0.3834073 -0.04559749  0.8715914  1.1619585 -1.26236232
2 -0.3551722 -0.6587208  0.44822253 -0.1943887 -0.4958392  0.09581703
           C          C          C         C
1 -0.1387091 -0.4638417 -2.3897681 0.6853864
2  0.1680119 -0.5990310  0.9779425 1.0819789

我想要做的是获取列的一个随机子集（特定大小），保持每组相同的列数（如果选择的样本大小大于属于一个组的列数，取该组的所有列）。

我已经尝试了这个问题中提到的方法的更新版本：

sample rows of subgroups from dataframe with dplyr

但我无法将列名映射到 by 参数。

有人可以帮我解决这个问题吗？

Answer 1

这是另一种方法，IIUC：

idx <- split(seq_along(dframe), names(dframe))
keep <- unlist(Map(sample, idx, pmin(7, lengths(idx))))

dframe[, keep]

解释：

第一步根据列名拆分列索引：

idx
# $A
# [1]  1  2  3  4  5  6  7  8  9 10
# 
# $B
# [1] 11 12 13 14 15 16 17 18 19 20 21 22 23 24
# 
# $C
# [1] 25 26 27 28 29 30

下一步我们使用

pmin(7, lengths(idx))
#[1] 7 7 6

确定每个组中的样本大小，并将其应用于idx 中的每个列表元素（组），使用Map。然后我们取消列出结果以获得单个列索引向量。

Answer 2

不确定您是否需要dplyr 的解决方案，但这里只有lapply：

dframe   <- as.data.frame(matrix(rnorm(60), ncol=30))
cletters <- rep(c("A","B","C"), times=c(10,14,6))
colnames(dframe) <- cletters

# Number of columns to sample per group
nc <- 8


res <- do.call(cbind,
       lapply(unique(colnames(dframe)),
              function(x){
                         dframe[,if(sum(colnames(dframe) == x) <= nc) which(colnames(dframe) == x) else sample(which(colnames(dframe) == x),nc,replace = F)]
                         }
))

它可能看起来很复杂，但如果少于nc，它实际上只取每组的所有列，如果有超过nc 列，它会随机抽样nc 列。

为了恢复您原来的列名方案，gsub 可以解决问题：

colnames(res) <- gsub('.[[:digit:]]','',colnames(res))