[R-pkg-devel] using optimx in a package

[Glenn Schultz]

All,

I am using optimx in my package to fit the term structure of interest rates.  When I call the function from the package I get the following error:

Error in optimx.check(par, optcfg$ufn, optcfg$ugr, optcfg$uhess, lower, : 
Cannot evaluate function at initial parameters
Called from: optimx.check(par, optcfg$ufn, optcfg$ugr, optcfg$uhess, lower, 
upper, hessian, optcfg$ctrl, have.bounds = optcfg$have.bounds, 
usenumDeriv = optcfg$usenumDeriv, ...)

However, if I run the function locally outside of the package it runs a provides the correct solution to the problem.  So, the issue is the function will not run correctly when called from the package.  Any suggestions are appreciated. This package is written in S4

Glenn

Here is a dput of the Rates Object
structure(list(Date = c("2016-07-11", NA), ED1M = c(0.47785, 
0.0833), ED3M = c(0.6691, 0.25), ED6M = c(0.9514, 0.5), USSW1 = c(0.74, 
1), USSW2 = c(0.82, 2), USSW3 = c(0.88, 3), USSW4 = c(0.93, 4
), USSW5 = c(1, 5), USSW7 = c(1.13, 7), USSW10 = c(1.31, 10), 
USSW30 = c(1.72, 30)), .Names = c("Date", "ED1M", "ED3M", 
"ED6M", "USSW1", "USSW2", "USSW3", "USSW4", "USSW5", "USSW7", 
"USSW10", "USSW30"), row.names = 1:2, class = "data.frame")


Requirements

require(lubridate)
require(termstrc)
require(optimx)

months.in.year = 12
weeks.in.year = 52
pmt.frequency = 2
min.principal = 100
days.in.month = 30.44
Rates <- RatesObject #Rates(trade.date = "07-11-2016")


Here is the function
CalibrateCIR <- function(trade.date = character, 
sigma = numeric()){

rates.data <- Rates(trade.date = trade.date) 
shortrate = as.numeric(rates.data[1,2])/100

#set the column counter to make cashflows for termstrucutre
ColCount <- as.numeric(ncol(rates.data))
Mat.Years <- as.numeric(rates.data[2,2:ColCount])
Coupon.Rate <- as.numeric(rates.data[1,2:ColCount])
Issue.Date <- as.Date(rates.data[1,1])

#initialize coupon bonds S3 class
#This can be upgraded when bondlab has portfolio function
ISIN <- vector()
MATURITYDATE <- vector()
ISSUEDATE <- vector()
COUPONRATE <- vector()
PRICE <- vector()
ACCRUED <- vector()
CFISIN <- vector()
CF <- vector()
DATE <- vector()
CASHFLOWS <- list(CFISIN,CF,DATE)
names(CASHFLOWS) <- c("ISIN","CF","DATE")
TODAY <- vector()
data <- list()
TSInput <- list()

### Assign Values to List Items #########
data = NULL
data$ISIN <- colnames(rates.data[2:ColCount])
data$ISSUEDATE <- rep(as.Date(rates.data[1,1]),ColCount - 1)
data$MATURITYDATE <-
sapply(Mat.Years, function(Mat.Years = Mat.Years, Issue = Issue.Date) 
{Maturity = if(Mat.Years < 1) {
Issue %m+% months(round(Mat.Years * months.in.year))} else 
{Issue %m+% years(as.numeric(Mat.Years))}
return(as.character(Maturity))
}) 
data$COUPONRATE <- ifelse(Mat.Years < 1, 0, Coupon.Rate) 
data$PRICE <- ifelse(
Mat.Years < 1, (1 + (Coupon.Rate/100))^(Mat.Years * -1) * 100, 100)
data$ACCRUED <- rep(0, ColCount -1)

for(j in 1:(ColCount-1)){
Vector.Length <- as.numeric(round(
difftime(data[[3]][j],
data[[2]][j],
units = c("weeks"))/weeks.in.year,5))

Vector.Length <- ifelse(round(Vector.Length) < 1, 1 , 
round(Vector.Length * pmt.frequency))

data$CASHFLOWS$ISIN <- append(
data$CASHFLOWS$ISIN, rep(data[[1]][j],Vector.Length))

data$CASHFLOWS$CF <- append(
data$CASHFLOWS$CF,
as.numeric(
c(rep((data[[4]][j]/100/pmt.frequency),Vector.Length-1) * min.principal,
(min.principal + 
(data$COUPONRATE[j]/100/pmt.frequency)* min.principal))))

by.months = ifelse(data[[4]][j] == 0, round(difftime(
data[[3]][j], rates.data[1,1])/days.in.month), 6)

data$CASHFLOWS$DATE <- append(
data$CASHFLOW$DATE, seq(
as.Date(data[[2]][j]) %m+% months(as.numeric(by.months)), 
as.Date(data[[3]][j]),
by = as.character(paste(by.months, "months", sep = " "))))

} #The Loop Ends here and the list is made

data$TODAY <- as.Date(rates.data[1,1])
TSInput[[as.character(rates.data[1,1])]] <- c(data)

#set term strucutre input (TSInput) to class couponbonds
class(TSInput) <- "couponbonds"
CashFlow <- TSInput[[1]]
CIR.CF.Matrix <<- create_cashflows_matrix(TSInput[[1]], include_price = TRUE)
CIR.Mat.Matrix <<- create_maturities_matrix(TSInput[[1]], include_price = TRUE )

#Objective function for the origin to be inaccessable the followign 
#condition must be met
# 2 * kappa * theta <= sigma^2 
CIRTune <- function(param = numeric(), 
shortrate = numeric(), 
sigma = sigma, 
cfmatrix = matrix(), 
matmatrix = matrix()){

kappa = param[1]
theta = param[2]

FwdRate <- CIRSim(kappa = kappa,
theta = theta,
shortrate = Rates[1,2]/100,
T = 30,
step = 6/months.in.year,
sigma = sigma,
N = 1)

Spot <- cumprod(1+(FwdRate))
t <- seq(1,length(Spot),1)
Spot <- Spot^(1/t)
#DiscMatrix <<- 1/(Spot^matmatrix)
CIRTune <- sqrt((sum(colSums((cfmatrix * 1/(Spot^matmatrix)))^2))/ncol(matmatrix))
return(CIRTune)
}

# Fit the model to the market 
fit <- optimx(par = c(.1, .05), 
fn = CIRTune, 
method = "L-BFGS-B",
lower = c(.1,.01),
upper = c(.9, .2) , 
shortrate = shortrate,
sigma = sigma,
cfmatrix = CIR.CF.Matrix, 
matmatrix = CIR.Mat.Matrix) 

return(fit)
}