Question

假设我们有以下数据

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

samplesID是从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

Answer 1

对于使用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)

enter image description here

例如，如果我们想要更多的样本，那么只有3个Ids，但是可以说，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

enter image description here

Answer 2

你可以这样做：

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

Answer 3

一种方法：

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], ]

从R中的主题ID重新取样

3 个答案: