问题描述
给出一个包含不同变量的计数和变化率的数据表，如何从给定速率的每个变量的计数中采样？例如，给定以下数据表，我可以遍历并使用sample或rbinorm函数获取所需的输出。但是，我尝试实现的数据集非常大。有提高性能的方法吗？
library(data.table)
set.seed(1)
dt <- data.table(
count = sample(10000:20000,100),rate = sample(1:20,100,replace = T) / 1000
)
system.time(
for (i in 1:nrow(dt)){
dt$sample_n[i] <- sum(sample(1:0,dt$count[i],prob = c(dt$rate[i],1-dt$rate[i]),replace = T))
}
)
system.time(
for (i in 1:nrow(dt)){
dt$sample_n2[i] <- rbinom(size = dt$count[i],n = 1,prob = dt$rate[i])
}
)
解决方法
所有采样函数通常都是矢量化的，这意味着您可以直接执行以下操作：
dt$sample_n2 <- rbinom(size = dt$count,n = nrow(dt),prob = dt$rate)
仅使用:=的{{1}}进行引用分配（无循环）。
设置
rbinom()解决方案
library(data.table)
options(datatable.print.class = TRUE)
sample_size <- 5e4
dt <- data.table(
count = sample(seq(10000,10000 + sample_size),size = sample_size),rate = sample(1:20,size = sample_size,replace = TRUE) / 1000
)
枪杀
dt[,sample_n := rbinom(n = .N,size = dt$count,prob = rate)]
dt
#> count rate sample_n
#> <int> <num> <int>
#> 1: 26100 0.016 431
#> 2: 15145 0.008 114
#> 3: 24952 0.001 23
#> 4: 31437 0.020 621
#> 5: 58358 0.008 468
#> ---
#> 49996: 30517 0.002 56
#> 49997: 59047 0.009 500
#> 49998: 48737 0.018 896
#> 49999: 29686 0.005 152
#> 50000: 52429 0.011 580
原始时间
results <- list()
set.seed(1)
dt <- data.table(
count = sample(seq(10000,replace = TRUE) / 1000
)
results$original1_no_modify <- system.time( # not modifying `dt`
for (i in 1:nrow(dt)) {
sum(
sample(1:0,dt$count[i],prob = c(dt$rate[i],1L - dt$rate[i]),replace = TRUE)
)
}
)
set.seed(1)
results$original1_modify <- system.time( # modifying `dt`
for (i in 1:nrow(dt)) {
dt$sample_n[i] <- sum(
sample(1:0,replace = TRUE)
)
}
)
results$original2_no_modify <- system.time( # not modifying `dt`
for (i in 1:nrow(dt)){
rbinom(size = dt$count[i],n = 1L,prob = dt$rate[i])
}
)
set.seed(1)
results$original2_modify <- system.time( # modifying `dt`
for (i in 1:nrow(dt)){
dt$sample_n2[i] <- rbinom(size = dt$count[i],prob = dt$rate[i])
}
)
+ := + mapply()（更快，但仍然是R级迭代）
rbinom()解决方案
results$mapply_no_modify <- system.time( # not modifying `dt`
mapply(
function(.count,.rate) rbinom(size = .count,prob = .rate),dt$count,dt$rate
)
)
set.seed(1)
results$mapply_modify <- system.time( # modifying `dt`
dt[,sample_n3 := mapply(
function(.count,count,rate
)]
)
最终数据帧
results$solution_no_modify <- system.time( # not modifing `dt`
rbinom(n = nrow(dt),prob = dt$rate)
)
set.seed(1)
results$solution_modify <- system.time(
dt[,sample_n4 := rbinom(n = .N,prob = rate)]
)
健全性检查
dt[]
#> count rate sample_n sample_n2 sample_n3 sample_n4
#> <int> <num> <int> <int> <int> <int>
#> 1: 34387 0.009 295 310 310 310
#> 2: 53306 0.019 1076 1004 1004 1004
#> 3: 14049 0.019 268 247 247 247
#> 4: 21570 0.002 45 55 55 55
#> 5: 35172 0.009 313 346 346 346
#> ---
#> 49996: 37432 0.020 724 722 722 722
#> 49997: 14985 0.006 82 76 76 76
#> 49998: 16007 0.007 107 106 106 106
#> 49999: 49298 0.003 145 140 140 140
#> 50000: 41427 0.001 49 40 40 40
结果
stopifnot(
identical(dt$sample_n2,dt$sample_n3) &&
identical(dt$sample_n3,dt$sample_n4)
)