从 R 中的主题 ID 重新采样答案

【问题标题】：Resampling from subject id's in R从 R 中的主题 ID 重新采样
【发布时间】：2014-12-30 01:05:29
【问题描述】：

假设我们有以下数据

set.seed(123)
dat <- data.frame(var1=c(10,35,13,19,15,20,19), id=c(1,1,2,2,2,3,4))
(sampledIDs <- sample(min(dat$id):max(dat$id), size=3, replace=TRUE))
> [1] 2 4 2

sampledIDs 是从dat$id 采样（带替换）的 id 向量。我需要生成的代码（并且也适用于具有更多变量的大型数据集）：

代码dat[which(dat$id%in%sampledIDs),] 没有给我我想要的，因为这段代码的结果是

dat$id==2 的主题在此数据中仅出现一次（我明白为什么会出现这样的结果，但不知道如何得到我想要的）。有人可以帮忙吗？

编辑：感谢您的回答，这里是所有答案的运行时间（对于那些感兴趣的人）：

                                                                 test replications elapsed relative user.self
3   dat[unlist(lapply(sampledIDs, function(x) which(x == dat$id))), ]         1000    0.67    1.000      0.64
1 dat[which(sapply(sampledIDs, "==", dat$id), arr.ind = TRUE)[, 1], ]         1000    0.67    1.000      0.67
2        do.call(rbind, split(dat, dat$id)[as.character(sampledIDs)])         1000    1.83    2.731      1.83
4                               setkey(setDT(dat), id)[J(sampledIDs)]         1000    1.33    1.985      1.33

【问题讨论】：

+1 用于提供答案分析以及明确说明的问题。
数据大小是多少？你提到你有一个大数据
不是真正的大数据，但比示例中的观察/变量更多：'data.frame': 4454 obs. of 15 variables。
您说您的数据很大...让我发布一个相对较大数据集的基准。 4K 数据集不大，很小

标签： r matrix sampling resampling

【解决方案1】：

你可以这样做：

do.call(rbind, split(dat, dat$id)[as.character(sampledIDs)])

【讨论】：

【解决方案2】：

一种方法：

dat[unlist(lapply(sampledIDs, function(x) which(x == dat$id))), ]
#     var1 id
# 3     13  2
# 4     19  2
# 5     15  2
# 7     19  4
# 3.1   13  2
# 4.1   19  2
# 5.1   15  2

另一种方法：

dat[which(sapply(sampledIDs, "==", dat$id), arr.ind = TRUE)[ , 1], ]

【讨论】：

【解决方案3】：

对于使用data.table binary search 的大数据集，这可能是最快的方法

library(data.table)
setkey(setDT(dat), id)[J(sampledIDs)]
#    var1 id
# 1:   13  2
# 2:   19  2
# 3:   15  2
# 4:   19  4
# 5:   13  2
# 6:   19  2
# 7:   15  2

编辑：这是一个不太大的数据集（1e+05 行）的基准，它说明了哪个是明显的赢家

library(data.table)
library(microbenchmark)

set.seed(123)
n <- 1e5
dat <- data.frame(var1 = sample(seq_len(100), n, replace = TRUE), id = sample(seq_len(10), n, replace = TRUE))
(sampledIDs <- sample(min(dat$id) : max(dat$id), size = 3, replace = TRUE))
dat2 <- copy(dat)

Sven1 <- function(dat) dat[unlist(lapply(sampledIDs, function(x) which(x == dat$id))), ]
Sven2 <- function(dat) dat[which(sapply(sampledIDs, "==", dat$id), arr.ind = TRUE)[ , 1], ]
flodel <- function(dat) do.call(rbind, split(dat, dat$id)[as.character(sampledIDs)])
David <- function(dat2) setkey(setDT(dat2), id)[J(sampledIDs)]

Res <- microbenchmark(Sven1(dat),
                      Sven2(dat), 
                      flodel(dat), 
                      David(dat2))
Res
# Unit: milliseconds
#        expr       min        lq    median        uq       max neval
#  Sven1(dat)  4.356151  4.817557  6.715533  7.313877 45.407768   100
#  Sven2(dat)  9.750984 12.385677 14.324671 16.655005 54.797096   100
# flodel(dat) 36.097602 39.680006 42.236017 44.314981 82.261879   100
# David(dat2)  1.813387  2.068749  2.154774  2.335442  8.665379   100

boxplot(Res)

例如，如果我们想要采样 3 个以上的 Id，但假设是 10 个，则基准变得荒谬

(sampledIDs <- sample(min(dat$id) : max(dat$id), size = 10, replace = TRUE))
[1]  7  6 10  9  5  9  5  3  7  3
# Unit: milliseconds
#       expr        min         lq     median         uq       max neval
#  Sven1(dat)  80.124502  89.141162  97.908365 104.111738 175.40919   100
#  Sven2(dat)  99.010410 127.797966 159.404395 170.751069 209.96887   100
# flodel(dat) 129.722435 144.847505 157.737362 178.242103 232.41293   100
# David(dat2)   2.431682   2.721038   2.855103   3.057796  19.60826   100

【讨论】：