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

2016-10-17 Thread ProfJCNash
You are calling an optimizer that wants gradients without specifying the 
gradient method. I've not done any work on
optimx for a couple of years -- on R-forge I've put optimrx which has a more 
maintainable design and allows more solvers
to be called using the optim() syntax, including parameter scaling, and also 
offers a clearer choice of which gradient
approximation is to be used. It's possible that the initial gradient could not 
be worked out, though the message talks
about the function.

I tried running the code, but there are some glitches that look like you 
transmitted in HTML or otherwise have
line endings or delimiters mangled. If you can post code that will run, I'll 
give it a try.

JN


On 16-10-16 02:05 PM, Glenn Schultz wrote:
> 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]], i

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

2016-10-16 Thread Dirk Eddelbuettel

On 16 October 2016 at 18:05, Glenn Schultz wrote:
| 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

Make sure you _import_ the optmix package correctly in _your_ package. What
is visible to the package, versus what your commandline sees, is (almost
entirely) governed by NAMESPACE and DESCRIPTION.

'R CMD check --as-cran', particular when R is R-devel, should have plenty of 
pointers.

Dirk

| 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

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

2016-10-16 Thread 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)
}