※ 引述《memphis (让你喜欢这世界~)》之铭言：
: 假设资料长这样
: ID V1 V2
: 1 10 11
: 1 11 12
: 1 12 13
: 2 13 14
: 2 14 15
: 2 15 16
: 3 16 17
: 3 17 18
: 4 18 19
: 4 19 20
: 先bootstrap ID
: s <- sample(unique(data$ID), replace=T)
: 再抓资料
: data2 <- data[data$ID %in% s] #这样就错了
: #s里是有重复的ID没错
: #可是 %in% 不会抓重复的值
: 网络上查寻的的结果,是用grr:::matches
: s_idx <- as.numeric(unlist(matches(s, data$ID, list=T)))
: data2 <- data[s_idx]
: 看起来还算简约, 只是为了一个小功能又要装一个pkg..有点烦躁
DF <- read.table(textConnection("
ID V1 V2
1 10 11
1 11 12
1 12 13
2 13 14
2 14 15
2 15 16
3 16 17
3 17 18
4 18 19
4 19 20"), header = TRUE)
# 简单的方式，只是可能unique ID多一点会久一些些
lenID <- length(unique(DF$ID))
s <- sample(unique(DF$ID), replace = TRUE)
s_idx <- which(sweep(matrix(rep(DF$ID, lenID), lenID, byrow = TRUE),
1, t(s), `==`), arr.ind = TRUE)
DF[s_idx[ , 2], ]
# plyr 只是简单的抓出来要的
library(plyr)
ldply(s, function(i) DF[DF$ID == i, ])
# dplyr 有点复杂Orz
library(dplyr)
library(tidyr)
DF %>% group_by(ID) %>% mutate(t = sum(s == ID[1])) %>%
summarise_each(funs(list(rep(., times = t))), -t) %>%
unnest
# data.table 用key加速抓取速度
library(data.table)
DT <- data.table(DF)
setkey(DT, ID)
rbindlist(lapply(s, function(i) DT[ID == i]))
# Rcpp 自干一个matches
library(Rcpp)
sourceCpp(code = "
#include <RcppArmadillo.h>
// [[Rcpp::depends(RcppArmadillo)]]
// [[Rcpp::export]]
SEXP bootstrapId(arma::Col<int> ID, arma::Col<int> idx) {
arma::uvec out = find(ID == idx[0]);
if (idx.n_elem > 1) {
for (arma::uword i = 1; i < idx.n_elem; ++i)
out.insert_rows(out.n_rows, find(ID == idx[i]));
}
if (out.n_elem == 0)
return R_NilValue;
return Rcpp::wrap(out);
}")
DF[bootstrapId(DF[["ID"]], s), ]
bootstrapId(DF[["ID"]], c(5,5,6,6)) # NULL