Resampling आर

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 

sampledIDs पहचान-पत्र कि dat$id से (प्रतिस्थापन के साथ) नमूना का एक वेक्टर है। ,

var1 id 
    13 2 
    19 2 
    15 2 
    19 4 
    13 2 
    19 2 
    15 2 

कोड dat[which(dat$id%in%sampledIDs),] मुझे नहीं देता है क्या मैं चाहता हूँ के बाद से इस कोड का परिणाम

है: मैं कोड है कि (अधिक चरों के साथ एक बड़े डेटासेट के लिए और काम करता है भी) में परिणाम की जरूरत है

var1 id 
    13 2 
    19 2 
    15 2 
    19 4 

जहां 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.tablebinary 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 आईडी नमूने के लिए चाहते हैं, लेकिन सुविधा देता है कहते हैं, 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 

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