[英]How to create a more efficient simulation loop for Monte Carlo in R
本練習的目的是創建營養攝入值的人口分布。 在早期的數據中有重復的措施,這些已被刪除,因此每一行都是數據框中的唯一人。
我有這個代碼,在使用少量數據幀行測試時效果很好。 對於所有7135行,它非常慢。 我試着給它計時,但是當我機器上的運行時間為15小時后,我把它撞壞了。 system.time
結果是Timing stopped at: 55625.08 2985.39 58673.87
。
我很感激有關加速模擬的任何意見:
Male.MC <-c()
for (j in 1:100) {
for (i in 1:nrow(Male.Distrib)) {
u2 <- Male.Distrib$stddev_u2[i] * rnorm(1, mean = 0, sd = 1)
mc_bca <- Male.Distrib$FixedEff[i] + u2
temp <- Lambda.Value*mc_bca+1
ginv_a <- temp^(1/Lambda.Value)
d2ginv_a <- max(0,(1-Lambda.Value)*temp^(1/Lambda.Value-2))
mc_amount <- ginv_a + d2ginv_a * Male.Resid.Var / 2
z <- data.frame(
RespondentID = Male.Distrib$RespondentID[i],
Subgroup = Male.Distrib$Subgroup[i],
mc_amount = mc_amount,
IndvWeight = Male.Distrib$INDWTS[i]/100
)
Male.MC <- as.data.frame(rbind(Male.MC,z))
}
}
對於我的數據集中的7135個觀測值中的每一個,創建100個模擬營養物值,然后返回到原始測量水平(模擬使用來自BoxCox轉化營養物值的非線性混合效應模型的結果)。
我寧願不使用for
循環,因為我讀到它們在R
中效率不高但我對基於apply
選項不夠了解,以便將它們用作替代方案。 R
正在獨立計算機上運行,通常這將是運行Windows 7變體的標准Dell型桌面,如果這會影響有關如何更改代碼的建議。
更新:要重現此測試, Lambda.Value
= 0.4和Male.Resid.Var
= 12.1029420429778和Male.Distrib$stddev_u2
是所有觀察值的常量值。
str(Male.Distrib)
是
'data.frame': 7135 obs. of 14 variables:
$ RndmEff : num 1.34 -5.86 -3.65 2.7 3.53 ...
$ RespondentID: num 9966 9967 9970 9972 9974 ...
$ Subgroup : Ord.factor w/ 6 levels "3"<"4"<"5"<"6"<..: 4 3 2 4 1 4 2 5 1 2 ...
$ RespondentID: int 9966 9967 9970 9972 9974 9976 9978 9979 9982 9993 ...
$ Replicates : num 41067 2322 17434 21723 375 ...
$ IntakeAmt : num 33.45 2.53 9.58 43.34 55.66 ...
$ RACE : int 2 3 2 2 3 2 2 2 2 1 ...
$ INDWTS : num 41067 2322 17434 21723 375 ...
$ TOTWTS : num 1.21e+08 1.21e+08 1.21e+08 1.21e+08 1.21e+08 ...
$ GRPWTS : num 41657878 22715139 10520535 41657878 10791729 ...
$ NUMSUBJECTS : int 1466 1100 1424 1466 1061 1466 1424 1252 1061 1424 ...
$ TOTSUBJECTS : int 7135 7135 7135 7135 7135 7135 7135 7135 7135 7135 ...
$ FixedEff : num 6.09 6.76 7.08 6.09 6.18 ...
$ stddev_u2 : num 2.65 2.65 2.65 2.65 2.65 ...
head(Male.Distrib)
是
RndmEff RespondentID Subgroup RespondentID Replicates IntakeAmt RACE INDWTS TOTWTS GRPWTS NUMSUBJECTS TOTSUBJECTS FixedEff stddev_u2
1 1.343753 9966 6 9966 41067 33.449808 2 41067 120622201 41657878 1466 7135 6.089918 2.645938
2 -5.856516 9967 5 9967 2322 2.533528 3 2322 120622201 22715139 1100 7135 6.755664 2.645938
3 -3.648339 9970 4 9970 17434 9.575439 2 17434 120622201 10520535 1424 7135 7.079757 2.645938
4 2.697533 9972 6 9972 21723 43.340180 2 21723 120622201 41657878 1466 7135 6.089918 2.645938
5 3.531878 9974 3 9974 375 55.660607 3 375 120622201 10791729 1061 7135 6.176319 2.645938
6 6.627767 9976 6 9976 48889 91.480049 2 48889 120622201 41657878 1466 7135 6.089918 2.645938
更新2:導致NaN
結果的函數行是
d2ginv_a <- max(0,(1-Lambda.Value)*temp^(1/Lambda.Value-2))
感謝大家的幫助和評論,以及回復的速度。
更新:@Ben Bolker是正確的,它是導致NaN問題的負temp
值。 我錯過了一些測試(在注釋掉函數之后,只返回temp
值,並調用我的結果數據框Test
)。 此代碼重現NaN
問題:
> min(Test)
[1] -2.103819
> min(Test)^(1/Lambda.Value)
[1] NaN
但是將值作為值放入然后運行相同的(?)計算會給我一個結果,所以在進行手動計算時我錯過了這個:
> -2.103819^(1/Lambda.Value)
[1] -6.419792
我現在有工作代碼(我認為)使用矢量化,而且速度非常快。 萬一其他人有這個問題,我發布下面的工作代碼。 我必須添加一個最小值來防止計算的<0問題。 感謝所有幫助過的人和咖啡。 我確實嘗試將rnorm
結果放到數據幀中,這確實減慢了速度,以這種方式創建它們然后使用cbind
非常快。 Male.Distrib
是我的7135觀測的完整數據框架,但是此代碼應該適用於我之前發布的縮減版本(未經測試)。
Min_bca <- ((.5*min(Male.AddSugar$IntakeAmt))^Lambda.Value-1)/Lambda.Value
Test <- Male.Distrib[rep(seq.int(1,nrow(Male.Distrib)), 100), 1:ncol(Male.Distrib)]
RnormOutput <- rnorm(nrow(Test),0,1)
Male.Final <- cbind(Test,RnormOutput)
Male.Final$mc_bca <- Male.Final$FixedEff + (Male.Final$stddev_u2 * Male.Final$RnormOutput)
Male.Final$temp <- ifelse(Lambda.Value*Male.Final$mc_bca+1 > Lambda.Value*Min_bca+1,
Lambda.Value*Male.Final$mc_bca+1, Lambda.Value*Min_bca+1)
Male.Final$ginv_a <- Male.Final$temp^(1/Lambda.Value)
Male.Final$d2ginv_a <- ifelse(0 > (1-Lambda.Value)*Male.Final$temp^(1/Lambda.Value-2),
0, (1-Lambda.Value)*Male.Final$temp^(1/Lambda.Value-2))
Male.Final$mc_amount <- Male.Final$ginv_a + Male.Final$d2ginv_a * Male.Resid.Var / 2
當天的教訓:
max()
,因為它從列中返回最大值,而我想從兩個值中獲得最大值。 ifelse
語句是替代語句。 這是解決2個最大速度問題的方法:
i
),我們一次計算它們。 replicate
,而不是循環MC復制( j
),這是一個簡化的apply
,用於此目的。 首先,我們加載數據集並為您正在做的事情定義一個函數。
Male.Distrib = read.table('MaleDistrib.txt', check.names=F)
getMC <- function(df, Lambda.Value=0.4, Male.Resid.Var=12.1029420429778) {
u2 <- df$stddev_u2 * rnorm(nrow(df), mean = 0, sd = 1)
mc_bca <- df$FixedEff + u2
temp <- Lambda.Value*mc_bca+1
ginv_a <- temp^(1/Lambda.Value)
d2ginv_a <- max(0,(1-Lambda.Value)*temp^(1/Lambda.Value-2))
mc_amount <- ginv_a + d2ginv_a * Male.Resid.Var / 2
mc_amount
}
然后我們復制了很多次。
> replicate(10, getMC(Male.Distrib))
[,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10]
[1,] 36.72374 44.491777 55.19637 23.53442 23.260609 49.56022 31.90657 25.26383 25.31197 20.58857
[2,] 29.56115 18.593496 57.84550 22.01581 22.906528 22.15470 29.38923 51.38825 13.45865 21.47531
[3,] 61.27075 10.140378 75.64172 28.10286 9.652907 49.25729 23.82104 31.77349 16.24840 78.02267
[4,] 49.42798 22.326136 33.87446 14.00084 25.107143 25.75241 30.20490 33.14770 62.86563 27.33652
[5,] 53.45546 9.673162 22.66676 38.76392 30.786100 23.42267 28.40211 35.95015 43.75506 58.83676
[6,] 34.72440 23.786004 63.57919 8.08238 12.636745 34.11844 14.88339 21.93766 44.53451 51.12331
然后你可以重新格式化,添加ID等,但這是主要計算部分的想法。 祝好運!
聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.