Merton default model with complex iterative approach

Question

I am using Merton default model with complex iterative approach.

I have already prepared my R codes but as I am quite new in R, they seem very inefficient, in sense that they runs almost 7 hours. My main problem is my for loop part.

I kindly ask you review my R codes and give any corrections which could make my R code more efficient i.e. they run less time.

I downloaded all data and R code here.

library(plyr)
library(nleqslv)
library(data.table)
library(zoo)
library(TTR)
df5<-read.table(file="df5final.txt", sep="\t", header=T)
df5<-df5[,-8]
NONA <- function(data, columns) {
 completeVec <- complete.cases(data[, columns])
 return(data[completeVec, ])
}
head(df5)
df5<-NONA(df5,9)
nrow(df5)
freq<-ddply(df5, .(id,BSheetyearlag), "nrow")
df5<-join(df5, freq, by=c("id","BSheetyearlag"))
nrow(df5)
df5<-subset(df5, !nrow < 250)
df5<-subset(df5 , !nrow > 260)
unique(df5$nrow)
nrow(df5)
df5$logret<-log(1+df5$ret)
df5<-as.data.table(df5)
head(df5, n=25)
df5$year<-format(as.Date(df5$date, "%d-%b-%y"), "%Y")
df5$year<-as.numeric(df5$year)
####annual risk free rate
df5$convert<-as.Date(paste("1",df5$BSheetyearlag,sep=""),
 format="%d %b %Y")
df5$year<-format(df5$convert, "%Y")
rfabsolyear<-read.table(file="riskfreeannual.txt", sep="\t", header=T)
head(rfabsolyear)
tail(df5,n=2)
rfabsolyear<-rfabsolyear[,-2]
library(plyr)
df5<-join(df5, rfabsolyear, by=c("year"))
sp500<-read.table(file="spdata.txt", sep="\t", header=T)
colnames(sp500)<-c("date", "price", "retsp")
sp500<-na.omit(sp500)
sp500$date<-format(as.Date(sp500$date, "%d-%b-%y"), "%d-%b-%y")
head(df5,n=20)
sp500<-na.omit(sp500)
df5<-join(df5, sp500, by=c("date"))
head(df5)
blackscholes <- function(S, X, rf, h, sigma) {
 d1 <- (log(S/X)+(rf+sigma^2/2)*h)/sigma*sqrt(h)
}
df5<-subset(df5, ! LTD %in% NA )
df5<-subset(df5, ! STD %in% NA )
df5<-subset(df5, ! LTD %in% 0 )
df5<-subset(df5, ! cap %in% 0 )
df5<-subset(df5, ! STD %in% -882 )
df5$cap<-df5$cap/1000
df5<-within(df5, LTD05<-df5$STD+0.5*df5$LTD)
nrow(df5)
df5<-within(df5, iterK<-df5$LTD05+df5$cap)
df5$logiterK<-log(df5$iterK)
df5<-as.data.table(df5)
df5[,rollsd:=rollapply(logret, 250, sd, fill = NA, align='right')*sqrt(250), by=c("id", "BSheetyearlag")]
df5[,assetreturn:=c(NA,diff(logiterK)),by=c("id", "BSheetyearlag")] 
df5[,rollsdasset:=rollapply(assetreturn, 249, sd, fill=NA, align='right')*sqrt(250), by=c("id", "BSheetyearlag")]
df5[,iterK1:=(cap+LTD05*exp(-rfabsol)*pnorm(blackscholes(iterK,LTD05,rfabsol, 1,rollsdasset[250]))-rollsdasset[250])/pnorm(blackscholes(iterK,LTD05,rfabsol, 1,rollsdasset[250])),by=c("id", "BSheetyearlag")] 
head(df5, n=254)
errors<-ddply( df5, .(id, BSheetyearlag), function(x) sum((x$iterK-x$iterK1)^2))
head(errors)
df5<-as.data.frame(df5)
nrow(df5)
head(df5)
df5<-join(df5, errors, by=c("id", "BSheetyearlag"))
df5<-as.data.table(df5)
for ( i in 1:nrow(errors)){
 while(errors$V1[i] >= 10^(-10)) {
 df5<-as.data.table(df5)
 df5[,iterK:= iterK1,by=c("id", "BSheetyearlag")] 
 df5[,assetreturn:=c(NA,diff(log(iterK))),by=c("id", "BSheetyearlag")] 
 df5[,rollsdasset:=rollapply(assetreturn, 249, sd, fill=NA, align='right')*sqrt(250), by=c("id", "BSheetyearlag")]
 df5[,iterK1:=(cap+LTD05*exp(-rfabsol)*pnorm(blackscholes(iterK,LTD05,rfabsol, 1,rollsdasset[250]))-rollsdasset[250])/pnorm(blackscholes(iterK,LTD05,rfabsol, 1,rollsdasset[250])),by=c("id", "BSheetyearlag")]
 df5<-as.data.frame(df5)
 errors$V1[i]<-sum((df5[df5$V1 %in% errors$V1[i],"iterK"]-df5[df5$V1 %in% errors$V1[i],"iterK1"])^2)
 }
}

• flodel: duplicate of codereview.stackexchange.com/questions/49276/…?