The Sim.DiffProc package implements pseudo-maximum likelihood via the fitsde()
function. The interface and the output of the fitsde
function are made as similar as possible to those of the standard mle
function in the stats4
package of the basic R system. The main arguments to fitsde
consist:
data
a univariate time series (ts
object).drift
and diffusion
indicate drift and diffusion coefficient of the SDE, is an expression
of two variables t
, x
and theta
names of the parameters, and must be nominated by a vector of theta = (theta[1], theta[2],..., theta[p])
for reasons of symbolic derived in approximation methods.start
must be specified as a named list, where the names of the elements of the list correspond to the names of the parameters as they appear in the drift
and diffusion
coefficient.pmle
argument must be a character
string specifying the method to use, can be either: "euler"
Euler pseudo-likelihood, "ozaki"
Ozaki pseudo-likelihood, "shoji"
Shoji pseudo-likelihood and "kessler"
Kessler pseudo-likelihood.optim.method
select the optimization method ("L-BFGS-B"
is used by default), and further arguments to pass to optim
function.lower
and upper
bounds on the variables for the Brent
or L-BFGS-B
method.The functions of type S3 method
(as similar of the standard mle
function in the stats4
package of the basic R system for the class fitsde
are the following:
coef
: which extracts model coefficients from objects returned by fitsde
.vcov
: returns the variance-covariance matrix of the parameters of a fitted model objects.logLik
: extract log-likelihood.AIC
: calculating Akaike’s Information Criterion for fitted model objects.BIC
: calculating Schwarz’s Bayesian Criterion for fitted model objects.confint
: computes confidence intervals for one or more parameters in a fitted model objects.The following we explain how to use this function to estimate a SDE with different approximation methods.
with \(\theta_{1}=1\), \(\theta_{2}=2\), \(\theta_{3}=0.5\) and \(\theta_{4}=0.3\). Before calling fitsde
, we generate sampled data \(X_{t_{i}}\), with \(\Delta t =10^{-4}\), as following:
f <- expression( (1+2*x) ) ; g <- expression( 0.5*x^0.3 )
sim <- snssde1d(drift=f,diffusion=g,x0=2,N=10^4,Dt=10^-4)
mydata <- sim$X
we set the initial values for the optimizer as \(\theta_{1}=\theta_{2}=\theta_{3}=\theta_{4}=1\), and we specify the coefficients drift and diffusion as expressions. you can use the upper
and lower
limits of the search region used by the optimizer (here using the default method "L-BFGS-B"
), and specifying the method to use with pmle="euler"
.
fx <- expression( theta[1]+theta[2]*x ) ## drift coefficient of model
gx <- expression( theta[3]*x^theta[4] ) ## diffusion coefficient of model
fitmod <- fitsde(data = mydata, drift = fx, diffusion = gx, start = list(theta1=1, theta2=1,
theta3=1,theta4=1),pmle="euler")
fitmod
##
## Call:
## fitsde(data = mydata, drift = fx, diffusion = gx, start = list(theta1 = 1,
## theta2 = 1, theta3 = 1, theta4 = 1), pmle = "euler")
##
## Coefficients:
## theta1 theta2 theta3 theta4
## 1.1287275 2.1913699 0.4899050 0.3095782
The estimated coefficients are extracted from the output object fitmod
as follows:
coef(fitmod)
## theta1 theta2 theta3 theta4
## 1.1287275 2.1913699 0.4899050 0.3095782
We can use the summary
function to produce result summaries of output object:
summary(fitmod)
## Pseudo maximum likelihood estimation
##
## Method: Euler
## Call:
## fitsde(data = mydata, drift = fx, diffusion = gx, start = list(theta1 = 1,
## theta2 = 1, theta3 = 1, theta4 = 1), pmle = "euler")
##
## Coefficients:
## Estimate Std. Error
## theta1 1.1287275 1.44133407
## theta2 2.1913699 0.20984636
## theta3 0.4899050 0.01019174
## theta4 0.3095782 0.01098450
##
## -2 log L: -66967.97
vcov
for variance-covariance matrice, and extract log-likelihood by logLik
:
vcov(fitmod)
## theta1 theta2 theta3 theta4
## theta1 2.077444e+00 -2.490563e-01 1.394691e-04 -3.899667e-05
## theta2 -2.490563e-01 4.403550e-02 5.538228e-06 -2.093221e-05
## theta3 1.394691e-04 5.538228e-06 1.038715e-04 -1.052829e-04
## theta4 -3.899667e-05 -2.093221e-05 -1.052829e-04 1.206593e-04
logLik(fitmod)
## [1] 33483.99
AIC(fitmod)
## [1] -66959.97
BIC(fitmod)
## [1] -66949.55
Computes confidence intervals for one or more parameters in a fitted SDE:
confint(fitmod, level=0.95)
## 2.5 % 97.5 %
## theta1 -1.6962354 3.9536904
## theta2 1.7800786 2.6026612
## theta3 0.4699295 0.5098804
## theta4 0.2880490 0.3311074
It is always possible to transform process \(X_t\) with a constant diffusion coefficient using the Lamperti transform.
Now we consider the Vasicek model, with \(f(x,\theta) = \theta_{1} (\theta_{2}- x)\) and constant volatility \(g(x,\theta) = \theta_{3}\), \begin{equation}\label{eq12} dX_{t} = \theta_{1} (\theta_{2}- X_{t}) dt + \theta_{3} dW_{t},\qquad X_{0}=5 \end{equation}with \(\theta_{1}=3\), \(\theta_{2}=2\) and \(\theta_{3}=0.5\), we generate sampled data \(X_{t_{i}}\), with \(\Delta t =10^{-2}\), as following:
f <- expression( 3*(2-x) ) ; g <- expression( 0.5 )
sim <- snssde1d(drift=f,diffusion=g,x0=5,Dt=0.01)
HWV <- sim$X
we set the initial values for the optimizer as \(\theta_{1}=\theta_{2}=\theta_{3}=1\), and we specify the coefficients drift and diffusion as expressions. Specifying the method to use with pmle="ozaki"
, which can easily be implemented in R as follows:
fx <- expression( theta[1]*(theta[2]- x) ) ## drift coefficient of model
gx <- expression( theta[3] ) ## diffusion coefficient of model
fitmod <- fitsde(data=HWV,drift=fx,diffusion=gx,start = list(theta1=1,theta2=1,
theta3=1),pmle="ozaki")
summary(fitmod)
## Pseudo maximum likelihood estimation
##
## Method: Ozaki
## Call:
## fitsde(data = HWV, drift = fx, diffusion = gx, start = list(theta1 = 1,
## theta2 = 1, theta3 = 1), pmle = "ozaki")
##
## Coefficients:
## Estimate Std. Error
## theta1 3.6410502 0.42461009
## theta2 2.0412504 0.04643124
## theta3 0.5127161 0.01146631
##
## -2 log L: -3104.02
If you want to have confidence intervals \(\theta_{1}\) and \(\theta_{2}\) parameters only, using the command confint
as following:
confint(fitmod,parm=c("theta1","theta2"),level=0.95)
## 2.5 % 97.5 %
## theta1 2.808830 4.473271
## theta2 1.950247 2.132254
with: \(a(t) = \theta_{1}t\), and we generate sampled data \(X_{t_{i}}\), with \(\theta_{1}=-2\), \(\theta_{2}=0.2\) and time step \(\Delta t =10^{-3}\), as following:
f <- expression(-2*x*t) ; g <- expression(0.2*x)
sim <- snssde1d(drift=f,diffusion=g,N=1000,Dt=0.001,x0=10)
mydata <- sim$X
we set the initial values for the optimizer as \(\theta_{1}=\theta_{2}=1\), and we specify the method to use with pmle="shoji"
:
fx <- expression( theta[1]*x*t ) ## drift coefficient of model
gx <- expression( theta[2]*x ) ## diffusion coefficient of model
fitmod <- fitsde(data=mydata,drift=fx,diffusion=gx,start = list(theta1=1,
theta2=1),pmle="shoji",lower=c(-3,0),upper=c(-1,1))
summary(fitmod)
## Pseudo maximum likelihood estimation
##
## Method: Shoji
## Call:
## fitsde(data = mydata, drift = fx, diffusion = gx, start = list(theta1 = 1,
## theta2 = 1), pmle = "shoji", lower = c(-3, 0), upper = c(-1,
## 1))
##
## Coefficients:
## Estimate Std. Error
## theta1 -1.4085224 0.343630005
## theta2 0.1982903 0.004435787
##
## -2 log L: -3417.592
with: \(a(t) = \theta_{1}t\) and \(b(t)=\theta_{2}\sqrt{t}\), the volatility depends on time: \(\sigma(t)=\theta_{3}t\). We generate sampled data of \(X_t\), with \(\theta_{1}=3\), \(\theta_{2}=1\) and \(\theta_{3}=0.3\), time step \(\Delta t =10^{-3}\), as following:
f <- expression(3*t*(sqrt(t)-x)) ; g <- expression(0.3*t)
sim <- snssde1d(drift=f,diffusion=g,M=1,N=1000,x0=2,Dt=0.001)
mydata <- sim$X
we set the initial values for the optimizer as \(\theta_{1}=\theta_{2}=\theta_{3}=1\), and we specify the method to use with pmle="kessler"
:
fx <- expression( theta[1]*t* ( theta[2]*sqrt(t) - x ) ) ## drift coefficient of model
gx <- expression( theta[3]*t ) ## diffusion coefficient of model
fitmod <- fitsde(data=mydata,drift=fx,diffusion=gx,start = list(theta1=1,
theta2=1,theta3=1),pmle="kessler")
summary(fitmod)
## Pseudo maximum likelihood estimation
##
## Method: Kessler
## Call:
## fitsde(data = mydata, drift = fx, diffusion = gx, start = list(theta1 = 1,
## theta2 = 1, theta3 = 1), pmle = "kessler")
##
## Coefficients:
## Estimate Std. Error
## theta1 2.7988138 0.268371073
## theta2 0.7726340 0.192091516
## theta3 0.3002192 0.006716556
##
## -2 log L: -8462.47
where: \(2 \theta_{1}> \theta^{2}_{3}\) condition to ensure attractiveness; we generate sampled data of this model, with \(\theta_{1}=5\), \(\theta_{2}=1\) and \(\theta_{3}=0.2\), \(\Delta t =10^{-3}\), as following:
theta1 = 5; theta2 = 1; theta3 = 0.2
f <- expression( ((0.5*theta3^2 *x^(theta2-1) - theta1)/ x^theta2) )
g <- expression( theta3 )
sim <- snssde1d(drift=f,diffusion=g,M=1,N=1000,x0=3,Dt=0.001)
mydata <- sim$X
we use fitsde
function to estimate the parameters of this model as follows:
fx <- expression( ((0.5*theta[3]^2 *x^(theta[2]-1) - theta[1])/ x^theta[2]) )
gx <- expression(theta[3])
fitmod <- fitsde(mydata,drift=fx,diffusion=gx, start = list(theta1=1,theta2=1,
theta3=1),lower=c(0,0,0),pmle="euler")
coef(fitmod)
## theta1 theta2 theta3
## 5.1002378 0.9952380 0.2013187
for to calculate the bias and confidence intervals of estimators it is easy, we can proceed as follows:
true <- c(theta1,theta2,theta3) ## True parameters
bias <- true-coef(fitmod)
bias
## theta1 theta2 theta3
## -0.100237756 0.004761964 -0.001318711
confint(fitmod)
## 2.5 % 97.5 %
## theta1 4.7466588 5.4538167
## theta2 0.9806679 1.0098082
## theta3 0.1923328 0.2103046
We generate data from true model with parameters \(\underline{\theta}=(2,0.3,0.5)\), initial value \(X_{0}=2\) and \(\Delta t =10^{-4}\), as following:
f <- expression( 2*x )
g <- expression( 0.3*x^0.5 )
sim <- snssde1d(drift=f,diffusion=g,M=1,N=10000,x0=2,Dt=0.0001)
mydata <- sim$X
We test the performance of the AIC statistics for the four competing models, we can proceed as follows:
## True model
fx <- expression( theta[1]*x )
gx <- expression( theta[2]*x^theta[3] )
truemod <- fitsde(data=mydata,drift=fx,diffusion=gx,start = list(theta1=1,
theta2=1,theta3=1),pmle="euler")
## competing model 1
fx1 <- expression( theta[1]+theta[2]*x )
gx1 <- expression( theta[3]*x^theta[4] )
mod1 <- fitsde(data=mydata,drift=fx1,diffusion=gx1,start = list(theta1=1,
theta2=1,theta3=1,theta4=1),pmle="euler")
## competing model 2
fx2 <- expression( theta[1]+theta[2]*x )
gx2 <- expression( theta[3]*sqrt(x) )
mod2 <- fitsde(data=mydata,drift=fx2,diffusion=gx2,start = list(theta1=1,
theta2=1,theta3=1),pmle="euler")
## competing model 3
fx3 <- expression( theta[1] )
gx3 <- expression( theta[2]*x^theta[3] )
mod3 <- fitsde(data=mydata,drift=fx3,diffusion=gx3,start = list(theta1=1,
theta2=1,theta3=1),pmle="euler")
## Computes AIC
AIC <- c(AIC(truemod),AIC(mod1),AIC(mod2),AIC(mod3))
Test <- data.frame(AIC,row.names = c("True mod","Comp mod1","Comp mod2","Comp mod3"))
Bestmod <- rownames(Test)[which.min(Test[,1])]
Bestmod
## [1] "True mod"
the estimates under the different models:
Theta1 <- c(coef(truemod)[[1]],coef(mod1)[[1]],coef(mod2)[[1]],coef(mod3)[[1]])
Theta2 <- c(coef(truemod)[[2]],coef(mod1)[[2]],coef(mod2)[[2]],coef(mod3)[[2]])
Theta3 <- c(coef(truemod)[[3]],coef(mod1)[[3]],coef(mod2)[[3]],coef(mod3)[[3]])
Theta4 <- c("",coef(mod1)[[4]],"","")
Parms <- data.frame(Theta1,Theta2,Theta3,Theta4,row.names = c("True mod",
"Comp mod1","Comp mod2","Comp mod3"))
Parms
## Theta1 Theta2 Theta3 Theta4
## True mod 1.8107966 0.3018689 0.4952373
## Comp mod1 -0.8867762 1.9792870 0.3018856 0.495182982648353
## Comp mod2 1.0947975 1.5990583 0.2997053
## Comp mod3 7.1921632 0.3013008 0.4981262
We make use of real data of the U.S. Interest Rates monthly form \(06/1964\) to \(12/1989\) (see Figure 1) available in package Ecdat, and we estimate the parameters \(\underline{\theta}=(\theta_{1},\theta_{2},\theta_{3},\theta_{4})\) of CKLS model. These data have been analyzed by Stefano et all (2014) with yuima package, here we confirm the results of the estimates by several approximation methods.
data(Irates)
rates <- Irates[, "r1"]
X <- window(rates, start = 1964.471, end = 1989.333)
plot(X)
we can now use all previous methods by fitsde
function to estimate the parameters of CKLS model as follows:
fx <- expression( theta[1]+theta[2]*x ) ## drift coefficient of CKLS model
gx <- expression( theta[3]*x^theta[4] ) ## diffusion coefficient of CKLS model
pmle <- eval(formals(fitsde.default)$pmle)
fitres <- lapply(1:4, function(i) fitsde(X,drift=fx,diffusion=gx,pmle=pmle[i],
start = list(theta1=1,theta2=1,theta3=1,theta4=1)))
Coef <- data.frame(do.call("cbind",lapply(1:4,function(i) coef(fitres[[i]]))))
Info <- data.frame(do.call("rbind",lapply(1:4,function(i) logLik(fitres[[i]]))),
do.call("rbind",lapply(1:4,function(i) AIC(fitres[[i]]))),
do.call("rbind",lapply(1:4,function(i) BIC(fitres[[i]]))),
row.names=pmle)
names(Coef) <- c(pmle)
names(Info) <- c("logLik","AIC","BIC")
Coef
## euler kessler ozaki shoji
## theta1 2.0769516 2.1433505 2.1153154 2.1015009
## theta2 -0.2631871 -0.2743368 -0.2690547 -0.2664674
## theta3 0.1302158 0.1259800 0.1265225 0.1316708
## theta4 1.4513173 1.4691660 1.4649140 1.4513080
Info
## logLik AIC BIC
## euler -237.8786 483.7572 487.1514
## kessler -237.7845 483.5690 486.9632
## ozaki -237.8356 483.6712 487.0654
## shoji -237.8786 483.7572 487.1514
In Figure 2 we reports the sample mean of the solution of the CKLS model with the estimated parameters and real data, their empirical \(95\%\) confidence bands (from the \(2.5th\) to the \(97.5th\) percentile), we can proceed as follows:
f <- expression( (2.076-0.263*x) )
g <- expression( 0.130*x^1.451 )
mod <- snssde1d(drift=f,diffusion=g,x0=X[1],M=200, N=length(X),t0=1964.471,
T=1989.333)
mod
## Ito Sde 1D:
## | dX(t) = (2.076 - 0.263 * X(t)) * dt + 0.13 * X(t)^1.451 * dW(t)
## Method:
## | Euler scheme of order 0.5
## Summary:
## | Size of process | N = 298.
## | Number of simulation | M = 200.
## | Initial value | x0 = 3.317.
## | Time of process | t in [1964.471,1989.333].
## | Discretization | Dt = 0.08342953.
plot(mod,plot.type="single",type="n",ylim=c(0,30))
lines(X,col=4,lwd=2)
lines(time(mod),mean(mod),col=2,lwd=2)
lines(time(mod),bconfint(mod,level=0.95)[,1],col=5,lwd=2)
lines(time(mod),bconfint(mod,level=0.95)[,2],col=5,lwd=2)
legend("topleft",c("real data","mean path",paste("bound of", 95,"% confidence")),inset = .01,col=c(4,2,5),lwd=2,cex=0.8)