將R NGA封裝函數應用於R中的ffdf

Question

我剛剛開始使用R嘗試進行危害分析。 本質上，我需要進行數值積分，獲取一些參數並將復雜的函數應用於每個事件。

我使用了ff和ffbase軟件包，因為隨着方案數量的增加，我的計算機速度大大降低。 這在某種程度上效果很好。

本質上，我正在執行的步驟如下：-創建所有事件組合的ffdf-對於所有這些事件，計算出地面運動預測方程（GMPE）所需的不同度量。 -使用計算為輸入的斷裂度量，從R NGA軟件包中應用（GMPE）功能。

這就是問題的所在，正如您從下面的代碼中看到的那樣，我編寫了一個循環函數，該循環函數可以接受地應用NGA函數，但是一旦遇到大約100000種情況，它就會陷入困境並花費如此長時間！

問題是我如何對ffdf的每個事件或行應用此NGA函數，以便它能有效地處理50,000,000個或更多事件。 我當時在想用ffapply，但在理解如何使用方面很掙扎！ 並且找不到示例。

我的代碼如下所示，它可能是農業用的，但我對R還是陌生的。任何幫助將不勝感激！！！ 提前致謝

R代碼如下：

#Create Variables to be combined
#Define Epicentral Distance
dRepi<-20
Repimax<-200
Rep<-ff(seq(dRepi/2, Repimax, by=dRepi))
#Define angle to epicenter
dang<-pi[1]/8
Anglemax<-2*pi[1]-dang
Angle<-ff(seq(0, Anglemax, by=dang))
#Define Magnitude
dmag<-0.1
Mmax<-7.5
Mmin<-5
Mag<-ff(seq(Mmin+dmag/2, Mmax-dmag/2, by=dmag))
#Define Epsilon
de<-0.5
emax<-3
emin<--3
e<-ff(seq(emin, emax,by=de))
#Define Fault Strike Angle
dtheta<- pi[1]/6
thetamax<- 2*pi[1]
thetamin<- 0
theta<-ff(seq(thetamin, thetamax-dtheta,by=dtheta))

#Create All Possible Event Combinations
Scenarios<-expand.ffgrid(e, Mag, Rep, Angle, theta)
colnames(Scenarios)<-c("Epsilon", "Magnitude", "EpiDistance", "EpiAngle", "theta")
#Number individual events
Nevs<-nrow(Scenarios)
Nevs#Display no. of events
Scenarios$EvNo <- ffdfwith(Scenarios, 1:Nevs)

#Calculate Rupture Metrics
Scenarios$Arup <- ffdfwith(Scenarios[c("Magnitude")], 10^(-3.42+0.9*Magnitude))
Scenarios$Wrup <- ffdfwith(Scenarios[c("Magnitude")], 10^(-0.76+0.27*Magnitude))
Scenarios$Lrup <- ffdfwith(Scenarios[c("Magnitude")],    10^(-3.42+0.9*Magnitude)/10^(-0.76+0.27*Magnitude))
Scenarios$Zhyp <- ffdfwith(Scenarios[c("Magnitude")], 5.63+0.68*Magnitude)
Scenarios$Ztor <- with(Scenarios[c("Magnitude")], ifelse((5.63+0.68*Magnitude-0.6*10^(-0.76+0.27*Magnitude)>0),( 5.63+0.68*Magnitude -0.6*10^(-0.76+0.27*Magnitude)),0))
Scenarios$Rx <-ffdfwith(Scenarios[c("EpiDistance", "EpiAngle", "theta")],abs(EpiDistance*sin(theta-EpiAngle)))
Scenarios$Rjba <- with(Scenarios[c("EpiDistance", "EpiAngle","Lrup","theta")],ifelse(((-   EpiDistance*sin(EpiAngle)*Lrup*sin(theta))+(-EpiDistance*cos(EpiAngle)*Lrup*cos(theta))<=0),( EpiDistance),0))
Scenarios$Rjbb <- with(Scenarios[c("EpiDistance", "EpiAngle","Lrup","theta")],ifelse(((Lrup*sin(theta))^2+(Lrup*cos(theta))^2<=-   EpiDistance*sin(EpiAngle)*Lrup*sin(theta)+-EpiDistance*cos(EpiAngle)*Lrup*cos(theta)),(((EpiDistance*sin(EpiAngle)+Lrup*sin(theta))^2+(EpiDistance*cos(EpiAngle)+Lrup*cos(theta))^2)^0.5),0))
Scenarios$Rjbc <- with(Scenarios[c("EpiDistance", "EpiAngle","Lrup","theta","Rjba","Rjbb")],ifelse((Rjba+Rjbb>0),0,( ((EpiDistance*sin(EpiAngle)+(((-EpiDistance*sin(EpiAngle)*Lrup*sin(theta))+(-EpiDistance*cos(EpiAngle)*Lrup*cos(theta)))/((Lrup*sin(theta))^2+(Lrup*cos(theta))^2))*Lrup*sin(theta))^2+(EpiDistance*cos(EpiAngle)+(((-EpiDistance*sin(EpiAngle)*Lrup*sin(theta))+(-EpiDistance*cos(EpiAngle)*Lrup*cos(theta)))/((Lrup*sin(theta))^2+(Lrup*cos(theta))^2))*Lrup*cos(theta))^2)^0.5

）））＃使用場景$ Rjbc <-with（Scenarios [c（“ Rx”，“ Rjba”，“ Rjbb”）]，ifelse（（Rjba + Rjbb> 0），0，Rx）來簡化

Scenarios$Rjb <- ffdfwith(Scenarios[c("Rjba", "Rjbb", "Rjbc")],Rjba+Rjbb+Rjbc)
Scenarios$Rrup <-ffdfwith(Scenarios[c("Rjb", "Ztor")],(Rjb^2+Ztor^2)^0.5)
Scenarios$AziRjba<-with(Scenarios[c("Rjba","EpiDistance", "EpiAngle","Lrup","theta")],ifelse(Rjba>0,(180/pi[1])*acos((-   EpiDistance*sin(EpiAngle)*Lrup*sin(theta)+-EpiDistance*cos(EpiAngle)*Lrup*cos(theta))/(Lrup*EpiDistance)),0))
Scenarios$AziRjbb<-with(Scenarios[c("Rjbb","Rx")],ifelse(Rjbb>0,180*asin(Rx/Rjbb)/pi[1],0))#Error message here NaNs produced!!!
Scenarios$AziRjbc<-with(Scenarios[c("Rjbc")],ifelse(Rjbc>0,90,0))
Scenarios$Azi <- ffdfwith(Scenarios[c("AziRjba", "AziRjbb", "AziRjbc")],AziRjba+AziRjbb+AziRjbc)

#Define Parameters for CY NGA model
M<-Scenarios$Magnitude
Rjb<-Scenarios$Rjb
epsilon<-Scenarios$Epsilon
Vs30<-300
VsFlag<-0
rake<-180
AS<-0
Rrup<-Scenarios$Rrup
Rx<-Scenarios$Rx
Ztor<-Scenarios$Ztor
Zhyp<-Scenarios$Zhyp
W<-Scenarios$Wrup
Azimuth<-Scenarios$Azi

#Define For Loop - Problem though with looping over large no. of rows!!!!
PGA = (rep(NA,Nevs))
for(i in 1:nrow(Scenarios)){
PGA[i]=Sa.cy(M[i],Rjb[i], Vs30, VsFlag, epsilon[i], T=0, Rrup[i], Rx[i],
      dip = 90, W[i], Ztor[i], Z1.0 = NA, rake, Frv = NA,
      Fnm = NA, Fhw=NA, Azimuth[i], Zhyp[i], AS)
}

Answer 1

一些一般性建議。 使用ffseq從包代替ffbase的ff(seq(..?如ffseq(dRepi/2, Repimax, by=dRepi)

關於您的最后一個代碼，如果Sa.cy是矢量化的，則可以在Sa.cy上使用塊，並將Sa.cy應用於Sa.cy中的數據，如下所示。

PGA = (rep(NA,Nevs))
mychunks <- chunk(Scenarios)
for(myblock in mychunks){
  ScenariosINRAM <- Scenarios[myblock, ]
  PGA[seq(min(myblock), max(myblock))] <- Sa.cy(ScenariosINRAM$Magnitude, ScenariosINRAM$Rjb, Vs30, VsFlag, ScenariosINRAM$Epsilon, T=0, 
                                                ScenariosINRAM$Rrup, ScenariosINRAM$Rx,
                                                dip = 90, ScenariosINRAM$Wrup, ScenariosINRAM$Ztor, Z1.0 = NA, rake, Frv = NA,
                                                Fnm = NA, Fhw=NA, ScenariosINRAM$Azi, ScenariosINRAM$Zhyp, AS)
}