Was given a task to code a tridiagonal solver.
However when i try to run the solver, i get no results.
I can't find my error in the code and would appreciate any help that i can get.
a<-cbind(-1,-1,-1)
b<-cbind(2.04,2.04,2.04,2.04)
c<-cbind(-1,-1,-1)
d<-c(40.8,0.8,0.8,200)
tridiagsolver<-function(a,b,c,d){
N<-length(b)
for (n in (2:N)){
ratio<-a[n]/b[n-1]
b[n]=b[n]-ratio*c[n-1]
d[n]=d[n]-ratio*d[n-1]
}
d[N]=d[N]/b[N]
for (n in (1:(N-1))){
d[N-n]=(d[N-n]-c[N-n]*d[N-n+1])/b[N-n]
}
return(d)
}
tridiagsolver(a,b,c,d)
> tridiagsolver(a,b,c,d)
[1] NA NA NA NA
Related
I am having an issue with using the optimx with the bbmle package. The model will run on my personal computer, but will not return viable results on a linux computer. Both are running the same code, on R version 4.1.3 and optimx package version 2021.10.12 and bbmle package version 1.0.24. I can run the NLL function on both computers and do not think it is an issue with the function itself. I have thus not included reproducible code as the NLL fxn works on my machine, additionally the NLL is not a simple model and the data is a large list. Below is my code for the mle runs:
require(bbmle)
require(optimx)
MLE.test <- mle2(minuslogl = nll,
start = log_start, #list of starting values for NLL arguments
fixed = list(cv_q = 0.5), # one argument from NLL that is fixed
data = list(dat = dat1, #list of data for NLL
scale = 1), # argument value set to a scale of 1
optimizer = "optimx",
method = "bobyqa",
lower = low, #vector of lower bounds
upper = upp, #vector of upper bounds
control=list(maxit=2000, trace=5), skip.hessian = TRUE)
The results on my Mac look like this
coef(MLE.test)
hypox_a hypox_b fi cv_q sigma_p rec1 rec2 rec3 rec4
3.4512339 1.7724387 -1.5397089 0.5000000 -1.9490732 1.3548618 -0.1552055 1.3323955 1.1739773
Log-likelihood: -9496.14
The results on the Linux computer look like this
coef(MLE.test)
hypox_a hypox_b fi cv_q sigma_p rec1 rec2 rec3 rec4
NA NA NA 0.5 NA NA NA NA NA
Log-likelihood: -8.988466e+307
I ran the MLE model with the "all.methods = T" approach to see if it was an error with loading the optimx package on the Linux machine, and the model ran until it reached the "bobyqa" method where it terminated.
The trace arguement returns this at the start of the model run with the "bobyqa" method
$have.bounds
[1] TRUE
$method
[1] "bobyqa"
Method: bobyqa
bobyqa failed for current problem
Post processing for method bobyqa
Save results from method bobyqa
$fevals
[1] NA
$value
[1] 8.988466e+307
$par
[1] NA NA NA NA NA NA NA NA
I then set up a text file in the NLL fxn to print parameters as they are being tested and this is what the Linux machine returns as updates. It eventually settles on the final line with all NAs and a NLL of 0.
Start time: 2022-04-12 10:13:07
// hypox_a= 4 / hypox_b= 1 / fi= -0.22314355131421 / sigma= -2.30258509299405 / NLL= 15171.9421911981
Start time: 2022-04-12 10:13:07
// hypox_a= NA / hypox_b= NA / fi= NA / sigma= NA / NLL= 0
Start time: 2022-04-12 10:13:07
// hypox_a= NA / hypox_b= NA / fi= NA / sigma= NA NLL= 0
Does anyone have suggestions for where this may have gone wrong or if there are compatibility issues with Linux machines?
installed the 'minqa' package which resolved the issue of NAs in place of the parameters and gave viable results with MLE2.
install.packages("minqa")
require(minqa)
I am using a Kalman filter to estimate various Dynamic and Arbitrage free Nelson-Siegel models for yield curves. I give some starting values to optim and the algorithm converges just fine. However, when I want to calculate standard errors using the Hessian supplied by the optim algorithm, I get NaN's due to nonpositive values on the diagonal of the Variance covariance matrix. I think it is because I have a highly nonlinear function with many local optima, however it keeps happening for all starting values I try.
The function I use is optim together with the default Nelder-Mead algorithm.
The command I use is
opt_para<-optim(par=par0, fn=Kalman_filter, y=y,
maturities=maturities,control=list(maxit=20000),hessian=TRUE) The starting values are given in par0, which is
> par0
[1] 9.736930e-01 1.046646e+00 5.936238e-01 4.444669e-02 2.889251e-07 6.646960e+00 7.715964e-01 9.945551e-01 9.663361e-01
[10] 6.000000e-01 6.000000e-01 6.000000e-01 6.000000e-02 5.000000e-01 5.000000e-01 5.000000e-01 5.000000e-01
The optimoutput that I get is
$par[1] 0.833208307 1.373442068 0.749313983 0.646577154 0.237102069 6.882644818 0.788775982 0.918378263 0.991982038
[10] 0.748509055 0.005115171 0.392213941 0.717186499 0.121525623 0.386227284
0.001970431 0.845279611
$value
[1] 575.7886
$counts
function gradient
5225 NA
$convergence
[1] 0
$message
NULL
I then use the following command to produce the standard errors of the estimates.
hessian<-opt_para$hessian
fish_info<-solve(hessian,tol=1e-100)
st_errors<- diag(sqrt(fish_info))
st_errors
I get the following output
st_errors
[1] NaN NaN 2.9170315888 NaN NaN NaN 0.0294300357 0.0373614751 NaN
[10] 0.0785349634 0.0005656580 NaN 0.0470600219 0.0053255251 0.0408666177 0.0001561243 0.4540428740
The NaNs are being produced to a negative value on the diagonal, which should be impossible in a variance-covariance matrix. However, I suspect that it is due to the optimization procedure being not correct.
To be clear, I also include the function I want to optimize. It is a Kalman-filter with updating equations and some restrictions built in.
Kalman_filter<-function(par, y, maturities){
b0<-c(par[1],par[2],par[3])
P0<-diag(c(par[4],par[5],par[6]))
Phi<-diag(c(par[7],par[8],par[9]))
mu<-c(par[10],par[11],par[12])
lambda<-par[13]
sigma11<-par[14]
sigma21<-par[15]
sigma22<-par[16]
sigma33<-par[17]
m=length(b0)
n=length(y[,1])
d<-length(y[1,])
sigma_eps<-sigma11*diag(d)
sigma_nu<-diag(c(sigma21^2,sigma22^2,sigma33^2))*(1/12)
colnames(sigma_nu)<-c("level","slope","Curvat")
X<-matrix(cbind(rep(1,length(maturities)), slope_factor(lambda,maturities), curv_factor(lambda,maturities)),ncol=3)
colnames(X)<-c("level","slope","Curvature")
bt<-matrix(NA, nrow=m, ncol=n+1)
Pt<-array(NA, dim=c(m,m,n+1))
btt<-matrix(NA, nrow=m,ncol=n+1)
Ptt<-array(NA, dim=c(m,m,n+1))
vt<-matrix(NA, nrow=d, ncol=n)
eigen_values<-eigen(Phi,only.values=TRUE)$values
if(eigen_values[1]>=1||eigen_values[2]>=1||eigen_values[3]>=1){
loglike=-70000000
}else{
c<- (diag(3) - Phi)%*% mu
loglike<-0
i<-1
btt[,1]<-b0
Ptt[,,1]<-P0
while(i< n+1){
bt[,i]<- c+ Phi%*% btt[,i]
Pt[,,i] <- Phi%*% tcrossprod(Ptt[,,i],Phi) + sigma_nu
vt[,i]<- y[i,] - X%*% bt[,i]
ft<-X%*% tcrossprod(Pt[,,i], X) + sigma_eps
det_f<-det(ft)
if( is.nan(det_f) || is.na(det_f)|| is.infinite(det_f)){
loglike<- - 700000000
} else
{
if(det_f<0){
loglike <- - 700000000
} else
{
if (abs(det_f>1e-20)){
logdet_f<- log(det_f)
f_inv<- solve(ft, tol=1e-200)
Kt<- tcrossprod(Pt[,,i],X)%*% f_inv
btt[,i+1] <- bt[,i] + Kt%*% vt[,i]
Ptt[,,i+1] <- (diag(3) - Kt%*% X)%*% Pt[,,i]
loglike_contr<- -0.5*d*log(2*pi) - 0.5 * logdet_f - 0.5*
crossprod(vt[,i],f_inv)%*% vt[,i]
loglike<-loglike+loglike_contr
} else
{ loglike<- -700000}
}
}
i<-i+1
}
}
return(-loglike)
}
Any help would be appreciated.
I have just solved the problem, I programmed the likelihood function once more with the only input parameters, the likelihood estimates from optim. After this, I used the hessianfunction from the numDerivpackage. This produces viable estimates for the standard errors.
I am a newbie of "R" and I want to write a script for back testing my strategy of buy and sell according to the EMA. I write the following code according to some reference from Web. However, the script got an error message in line 72 but I cannot figure out the problem. Anybody can help to solve my problem? Thanks in advance.
library(quantmod)
stock1<-getSymbols("^DJI",src="yahoo",from="2010-01-01",auto.assign=F)
stock1<-na.locf(stock1)
stock1$EMA9<-EMA(Cl(stock1),n=9)
stock1$EMA19<-EMA(Cl(stock1),n=19)
stock1$EMACheck<-ifelse(stock1$EMA9>stock1$EMA19,1,0)
stock1$EMA_CrossOverUp<-ifelse(diff(stock1$EMACheck)==1,1,0)
stock1$EMA_CrossOverDown<-ifelse(diff(stock1$EMACheck)==-1,-1,0)
stock1<-stock1[index(stock1)>="2010-01-01",]
stock1_df<-data.frame(index(stock1),coredata(stock1))
colnames(stock1_df)<-c("Date","Open","High","Low","Close","Volume","Adj","EMA9","EMA19","EMACheck","EMACheck_up","EMACheck_down")
head(stock1_df)
#To calculate the number of crossoverup transactions during the duration from 2010-01-01
sum(stock1_df$EMACheck_up==1 & index(stock1)>="2010-01-01",na.rm=T)
stock1_df$Date[stock1_df$EMACheck_up==1 & index(stock1)>="2010-01-01"]
sum(stock1_df$EMACheck_down==-1 & index(stock1)>="2010-01-01",na.rm=T)
stock1_df$Date[stock1_df$EMACheck_down==-1 & index(stock1)>="2010-01-01"]
#To generate the transcation according to the strategy
transaction_dates<-function(stock2,Buy,Sell)
{
Date_buy<-c()
Date_sell<-c()
hold<-F
stock2[["Hold"]]<-hold
for(i in 1:nrow(stock2)) {
if(hold == T) {
stock2[["Hold"]][i]<-T
if(stock2[[Sell]][i] == -1) {
#stock2[["Hold"]][i]<-T
hold<-F
}
} else {
if(stock2[[Buy]][i] == 1) {
hold<-T
stock2[["Hold"]][i]<-T
}
}
}
stock2[["Enter"]]<-c(0,ifelse(diff(stock2[["Hold"]])==1,1,0))
stock2[["Exit"]]<-c(ifelse(diff(stock2[["Hold"]])==-1,-1,0),0)
Buy_date <- stock2[["Date"]][stock2[["Enter"]] == 1]
Sell_date <- stock2[["Date"]][stock2[["Exit"]] == -1]
if (length(Sell_date)<length(Buy_date)){
#Sell_date[length(Sell_date)+1]<-tail(stock2[["Date"]],n=2)[1]
Buy_date<-Buy_date[1:length(Buy_date)-1]
}
return(list(DatesBuy=Buy_date,DatesSell=Sell_date))
}
#transaction dates generate:
transactionDates<-transaction_dates(stock1_df,"EMACheck_up","EMACheck_down")
transactionDates
num_transaction1<-length(transactionDates[[1]])
Open_price<-function(df,x) {df[as.integer(rownames(df[df[["Date"]]==x,]))+1,][["Open"]]}
transactions_date<-function(df,x) {df[as.integer(rownames(df[df[["Date"]]==x,]))+1,][["Date"]]}
transactions_generate<-function(df,num_transaction)
{
price_buy<-sapply(1:num_transaction,function(x) {Open_price(df,transactionDates[[1]][x])})
price_sell<-sapply(1:num_transaction,function(x) {Open_price(df,transactionDates[[2]][x])})
Dates_buy<-as.Date(sapply(1:num_transaction,function(x) {transactions_date(df,transactionDates[[1]][x])}))
Dates_sell<-as.Date(sapply(1:num_transaction,function(x) {transactions_date(df,transactionDates[[2]][x])}))
transactions_df<-data.frame(DatesBuy=Dates_buy,DatesSell=Dates_sell,pricesBuy=price_buy,pricesSell=price_sell)
#transactions_df$return<-100*(transactions_df$pricesSell-transactions_df$pricesBuy)/transactions_df$pricesBuy
transactions_df$Stop_loss<-NA
return(transactions_df)
}
transaction_summary<-transactions_generate(stock1_df,num_transaction1)
transaction_summary$Return<-100*(transaction_summary$pricesSell-transaction_summary$pricesBuy)/transaction_summary$pricesBuy
transaction_summary
Your code fails on this line:
transactionDates<-transaction_dates(stock1_df,"EMACheck_up","EMACheck_down")
The reason is that the first 19 records of stock1_df contain NA values in the columns "EMACheck_up" and "EMACheck_down".
head(stock1_df)
EMACheck_up EMACheck_down
1 NA NA
2 NA NA
3 NA NA
4 NA NA
5 NA NA
6 NA NA
You can solve your issue by running na.locf before running the offending line of code.
stock1_df <- na.locf(stock1_df)
transactionDates <-
transaction_dates(stock1_df, "EMACheck_up", "EMACheck_down")
Skipping the first 19 rows (or first month) would also work.
You might want to look into quantstrat if you want to do more in backtesting strategies. But what you have now does the trick.
Let's say I have this for loop
results<-c()
score<-c(19,14,13,9,"A",15)
for(index in 1:length(score)){
results[index]<- index + score[index]
}
how can I return the results before the error happen?
> results
[1] 20 16 16 13
Can I stop the loop while its working and return results even didn't finish all the index?
You can try capturing the warning or error like this using tryCatch. As soon as a condition occurs, the loop will be stopped and control is transferred to corresponding warning or error functions.
results<-c()
score<-c(19,14,13,9,"A",15)
tryCatch(expr = {
for(index in 1:length(score)){
results[index]<- index + as.numeric(score[index])
}
},warning=function(w){print(w)},
error=function(e){print(e)},
finally = results)
<simpleWarning in doTryCatch(return(expr), name, parentenv, handler): NAs introduced by coercion>
> results
#[1] 20 16 16 13
I think here comes break flow control handy:
results<-c()
score<-c(19,14,13,9,"A",15)
for(index in 1:length(score)){
if(is.na(suppressWarnings(as.numeric(score[index])))){
break
}
results[index]<- index + as.numeric(score[index])
}
results
#[1] 20 16 16 13
I try to create a function. But when I change the sequence of it then it create NA values out. Any particular reason to it? Thanks
new<-function(x){
min2<-NULL
min1<-NULL
len<-length(unique(x))
for (i in 1:(len-1))
min2[i]<-sort(x,partial=(len-i+1))[(len-i+1)]
min1[i]<-sort(x,partial=(len-i)) [(len-i)]
return((min1))
}
x<-c(1,11,40,120)
new(x)
[1] 120 40 11
new<-function(x){
min2<-NULL
min1<-NULL
len<-length(unique(x))
for (i in 1:(len-1))
min1[i]<-sort(x,partial=(len-i)) [(len-i)]
min2[i]<-sort(x,partial=(len-i+1))[(len-i+1)]
return((min1))
}
x<-c(1,11,40,120)
new(x)
[1] NA NA 11
You forgot curly parentheses around the expression you want to repeat in you for loop:
new<-function(x){
min2<-NULL
min1<-NULL
len<-length(unique(x))
for (i in 1:(len-1)) {
min2[i]<-sort(x,partial=(len-i+1))[(len-i+1)]
min1[i]<-sort(x,partial=(len-i)) [(len-i)]
}
return(min1)
}