特定值的一个数据帧的总和高效采样

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的数量很好地扩展。