特定值的一個數據幀的總和高效採樣

Question

我的數據是這樣的：

df <- data.frame(
    x = c("dog", "dog", "dog", "cat", "cat", "fish", "fish", "fish", "squid", "squid", "squid"), 
    y = c(10, 11, 6, 3, 4, 5, 5, 9, 14, 33, 16) 
) 

我想通過數據進行迭代，並在某些「列入/過濾器」列表抓住每個動物的一個值，然後將它們相加。

例如，也許我只關心狗，貓和魚。

animals <- c("dog", "cat", "fish") 

在再取樣1，我能得到10，圖4，圖9（總和= 23），並在再取樣2我能得到6,3，5（總和= 14）。

我剛剛颳起了真正janky重複/爲上dplyr傾斜功能，但它似乎超級低效：

ani_samp <- function(animals){ 

    total <- 0 
    for (i in animals) { 

     v <- df %>% 
      filter(x == i) %>% 
      sample_n(1) %>% 
      select(y) %>% 
      as.numeric() 

     total <- total + v 
    } 
    return(total) 
} 

replicate(1000,ani_samp(animals)) 

我會如何改善這種採樣/僞引導代碼？

Answer 1

我不確定是否這樣更好（沒有時間進行基準測試），但是可以避免這裏的雙循環。你可以先用animals進行過濾（因此可以在一個子集上工作），然後從每個組中抽取一次樣本n。如果你喜歡dplyr，這裏有一個可能dplyr/tidyr版本

library(tidyr) 
library(dplyr) 

ani_samp <- function(animals, n){ 
    df %>% 
    filter(x %in% animals) %>% # Work on a subset 
    group_by(x) %>% 
    sample_n(n, replace = TRUE) %>% # sample only once per each group 
    group_by(x) %>% 
    mutate(id = row_number()) %>% # Create an index for rowSums 
    spread(x, y) %>% # Convert to wide format for rowSums 
    mutate(res = rowSums(.[-1])) %>% # Sum everything at once 
    .$res # You don't need this if you want a data.frame result instead 
} 

set.seed(123) # For reproducible output 
ani_samp(animals, 10) 
# [1] 18 24 14 24 19 18 19 19 19 14 

Answer 2

另一種方式來做到這一點：

set.seed(123) ## for reproducibility 
n <- 1000 ## number of samples for each animal 
samps <- do.call(cbind, lapply(animals, function(x) {sample(df$y[df$x == x], n, replace=TRUE)})) 
head(samps, 10) 
##  [,1] [,2] [,3] 
## [1,] 10 3 5 
## [2,] 6 4 5 
## [3,] 11 3 5 
## [4,] 6 4 5 
## [5,] 6 4 5 
## [6,] 10 3 5 
## [7,] 11 4 5 
## [8,] 6 3 5 
## [9,] 11 3 5 
##[10,] 11 3 5 
sum <- as.vector(samps %*% rep(1,length(animals))) 
head(sum, 10) 
##[1] 18 15 19 15 15 18 20 14 19 19 

在這裏，我們使用lapply地遍歷animals，併產生1000個樣本的df$y爲此df$x使用sample替代動物匹配動物。然後，我們cbind結果在一起，以便samp的每一行是animals的採樣。最後一行是使用矩陣乘法的行和。

system.time因爲這是對每個animal的1000個樣本幾乎瞬間：

n <- 1000 ## number of samples for each animal 
system.time(as.vector(do.call(cbind, lapply(animals, function(x) {sample(df$y[df$x == x], n, replace=TRUE)})) %*% rep(1,length(animals)))) 
## user system elapsed 
## 0.001 0.000 0.001 

這也應與樣品n的數量很好地擴展。