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