对数据帧中特定值的总和进行有效的重采样答案

【问题标题】：Efficient resampling for the sum of specific values in a dataframe对数据帧中特定值的总和进行有效的重采样
【发布时间】：2016-10-09 13:37:58
【问题描述】：

我的数据如下所示：

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）。

我刚刚创建了一个依赖dplyr 的非常糟糕的复制/for 函数，但它似乎效率极低：

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))

我该如何改进这个重采样/伪引导代码？

【问题讨论】：

标签： r dplyr

【解决方案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

【讨论】：

【解决方案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 的样本数量。

【讨论】：