将R包函数应用于R中的ffdf

Question

我刚刚开始使用R来尝试进行危险分析。本质上，我需要进行数值积分，获得一些参数，并对每个事件应用一个复杂的函数。

我使用了ff和ffbase包，因为我的计算机随着场景数量的增加而急剧减速。这在某种程度上是行之有效的。

本质上，我正在做的步骤如下：-创建所有事件组合的ffdf -为所有这些事件计算出地面运动预测方程(GMPE)所需的不同指标。-应用R包中的(GMPE)函数，使用作为输入的断裂度量。

这就是它出了问题的地方，正如您从下面的代码中看到的，我编写了一个循环函数，它可以接受地应用NGA函数，但是一旦达到大约100000种情况，它就会变得混乱而耗时如此之长！

问题是如何对ffdf的每一个事件或行应用这个NGA函数，这样它将有效地工作在5000万或更多的事件上。我在考虑如何使用它，但是我很难理解它！却找不到例子。

我的代码如下所示，它可能是农业的，但我是新的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(Scenariosc("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

一些一般性的建议。使用包ffbase中的ffseq而不是ff(seq(..?中的ffseq(dRepi/2, Repimax, by=dRepi)

关于最后一段代码，如果Sa.cy是矢量化的，您可以在ffdf上使用块，并对块中的数据应用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)
}