R代码:有没有办法让蒙特卡罗模拟更快?
想象一下,我递给你一个印有“-1”的乒乓球。然后我告诉你们从一个标有“第一个袋子”的袋子里再抽一个乒乓球。这个袋子里有30000个球,有些标有“-1”,有些标有“0”,有些标有“+1”。无论你抽到哪个球,你都要把它的号码加到你当前的“分数”中-1。例如,如果你的分数是-1,你的新分数是-2 只要你的新分数低于零,你就可以从第一个袋子中再次抽签,并再次添加到你的分数中。但是,如果你的分数达到零或更高,你就从第二个袋子里抽签,这个袋子的成分不同,分别是-1秒、0秒和+1秒 我希望你从合适的袋子里总共抽出1000个乒乓球(即,取决于你当前的分数是否低于零),然后在“集合”的末尾写下你的总(累计)分数。然后我想让你们重复这个实验一百万次,告诉我你们最终得到的分数高于零的百分比是多少 有没有更快/更有效的方法来编写此代码?虽然我可以使用R代码:有没有办法让蒙特卡罗模拟更快?,r,loops,simulation,montecarlo,R,Loops,Simulation,Montecarlo,想象一下,我递给你一个印有“-1”的乒乓球。然后我告诉你们从一个标有“第一个袋子”的袋子里再抽一个乒乓球。这个袋子里有30000个球,有些标有“-1”,有些标有“0”,有些标有“+1”。无论你抽到哪个球,你都要把它的号码加到你当前的“分数”中-1。例如,如果你的分数是-1,你的新分数是-2 只要你的新分数低于零,你就可以从第一个袋子中再次抽签,并再次添加到你的分数中。但是,如果你的分数达到零或更高,你就从第二个袋子里抽签,这个袋子的成分不同,分别是-1秒、0秒和+1秒 我希望你从合适的袋子里总共
ifelse
和filter
的组合,但是由于绘图不是独立的,所以很难对循环进行矢量化?不过,我怀疑复制才是最昂贵的部分
ptm <- proc.time()
###First bag
n=30000
s=155
f=255
z=n-s-f
first_bag=c(rep(0,z), rep(1,s), rep(-1,f))
###Second bag
n2=30000
s2=275
f2=285
z2=n2-s2-f2
second_bag=c(rep(0,z2), rep(1,s2), rep(-1,f2))
###Simulate draws
sim_draw=function(draws){
score=-1
for (i in 1:draws) {
if (score < 0) {
score=score + sample(first_bag, 1, replace=TRUE)} else {
score=score + sample(second_bag, 1, replace=TRUE)}
}
score
}
###Repeat sims and find area above zero
samp_distribution=replicate(1000000, sim_draw(1000))
mean(samp_distribution>0)
print(proc.time() - ptm)
ptm 0)
打印(过程时间()-ptm)
一些想法:
?summaryRprof
底部的示例,只需将示例(glm)
替换为您的代码:samp\U发行版,我建议对代码进行优化(只要它能工作)。非常感谢!仅仅第一次改变就非常有用。我还将审查你的所有建议和建议,以确保我理解它们。再次感谢。
sim_draw_1 <- function(draws){
s1 <- sample(bag1, draws, replace = TRUE)
s2 <- sample(bag2, draws, replace = TRUE)
score <- -1
for (i in 1:draws)
score <- score + if (score < 0) s1[i] else s2[i]
score
}
library(microbenchmark)
microbenchmark(sim_draw(1000), sim_draw_1(1000),
times = 1000)
# Unit: microseconds
# expr min lq median uq max neval
# sim_draw(1000) 5518.758 5845.465 6036.1375 6340.662 53023.483 1000
# sim_draw_1(1000) 690.796 730.292 743.8435 785.071 8248.163 1000
library(compiler)
sim_draw_2 <- cmpfun(sim_draw_1)
library(microbenchmark)
microbenchmark(sim_draw_1(1000), sim_draw_2(1000), times = 1000)
# Unit: microseconds
# expr min lq median uq max neval
# sim_draw_1(1000) 684.687 717.6640 748.3305 812.971 9412.936 1000
# sim_draw_2(1000) 242.895 259.8125 268.3925 294.343 1710.290 1000
sim_draw_3 <- function(draws, bag1 = first_bag,
bag2 = second_bag){
s1 <- sample(bag1, draws, replace = TRUE)
s2 <- sample(bag2, draws, replace = TRUE)
score <- -1L
idx <- 1L
while (idx <= draws) {
bag <- if (score < 0) s1 else s2
switch.at <- if (score < 0) 0L else -1L
next.draws <- bag[idx:draws]
next.scores <- score + cumsum(next.draws)
stop.idx <- which(next.scores == switch.at)[1]
if (is.na(stop.idx)) stop.idx <- length(next.draws)
score <- next.scores[stop.idx]
idx <- idx + stop.idx
}
score
}
sim_draw_4 <- cmpfun(sim_draw_3)
microbenchmark(sim_draw_2(1000), sim_draw_3(1000), sim_draw_4(1000), times = 1000)
# Unit: microseconds
# expr min lq median uq max neval
# sim_draw_2(1000) 236.916 252.540 269.1355 293.7775 7819.841 1000
# sim_draw_3(1000) 80.527 95.185 128.9840 162.7790 625.986 1000
# sim_draw_4(1000) 79.486 92.378 123.5535 162.5085 518.594 1000