This file provides replication materials for examples and analysis conducted in the paper “Likelihood Inference for Non-Linear Multivariate Jump Diffusions with State Dependent Intensity”, which develops the methodology on which the DiffusionRjgqd package is built. As such, this file may not be useful as a stand-alone document, and should be read in conjunction with the paper. Note further:
In order to save time and keep this document readable, we reffrain from producing output for some of the examples.
Some of the examples provided here are given in greater detail within the package vignettes (start here, or skip to the further reading section).
See also:
library(DiffusionRjgqd)
# Define the process in DiffusionRjgqd syntax:
JGQD.remove()
## [1] "Removed : NA "
G0=function(t){2*5}
G1=function(t){-2}
Q1=function(t){0.25}
Jmu = function(t){1.0}
Jsig = function(t){0.5}
Lam0 = function(t){0}
Lam1 = function(t){0.5*(1+sin(3*pi*t))}
Lam2 = function(t){0.1*(1+cos(3*pi*t))}
# Define the jump diffusion coefficients for simulation:
mu = function(x,t){G0(t)+G1(t)*x}
sigma = function(x,t){sqrt(Q1(t)*x)}
j = function(x,z){z}
lambd = function(x,t){(Lam0(t)+Lam1(t)*x+Lam2(t)*x^2)}
simulate=function(x0=4,TT=1.15,N=25000,pts =c(1,2,3,4,5),brks=25)
{
d=0 # Time index
delta=1/2000 # Step size
tt=seq(0,TT,delta) # Equispaced points on [0,TT]
X=rep(x0,N) # Initialize the state vector
isjump = rep(0,N) # Used for counting the number of jumps
probs=matrix(1,3,length(tt)) # Used to store probabilities
# Storage of snapshots of the simulated trajectories:
L = list()
count =1
for(i in 2:length(tt))
{
# Simulate the occurance of a jump event:
events = (1-exp(-lambd(X,d)*delta)>runif(N))
wh=which(events)
whn = which(!events)
# For those trajectories that events do occur, simulate a jumps
# half a step forward:
if(any(events))
{
X[wh]=X[wh]+mu(X[wh],d)*delta/2+sigma(X[wh],d)*rnorm(length(wh),sd=sqrt(delta/2))
X[wh]=X[wh]+j(X[wh],rnorm(length(wh),Jmu(d+delta/2),Jsig(d+delta/2)))
X[wh]=X[wh]+mu(X[wh],d+delta/2)*delta/2+sigma(X[wh],d+delta/2)*rnorm(length(wh),sd=sqrt(delta/2))
}
# Update jump free trajectories in standard fashion:
X[whn]=X[whn]+mu(X[whn],d)*delta+sigma(X[whn],d)*rnorm(length(whn),sd=sqrt(delta))
d=d+delta
isjump = isjump +events
probs[1,i] = sum(isjump==0)/N
probs[2,i] = sum(isjump==1)/N
probs[3,i] = sum(isjump==2)/N
# Take snapshots at pts[count]:
if(sum(pts==round(d,4))!=0)
{
L[[count]] = hist(X,plot=F,breaks=brks)
count=count+1
}
}
return(list(probs=probs,time =tt,X=X,hists=L,pts=pts))
}
res2a=simulate()
resa=JGQD.density(Xs=4,Xt=seq(0,20,1/10),s=0,t=1.15,delt=1/100,factorize = TRUE)
##
## ================================================================
## Jump Generalized Quadratic Diffusion (JGQD)
## ================================================================
## _____________________ Drift Coefficients _______________________
## G0 : 2*5
## G1 : -2
## G2
## ___________________ Diffusion Coefficients _____________________
## Q0
## Q1 : 0.25
## Q2
## _______________________ Jump Mechanism _________________________
## ......................... Intensity ............................
## Lam0 : 0
## Lam1 : 0.5*(1+sin(3*pi*t))
## Lam2 : 0.1*(1+cos(3*pi*t))
## ........................... Jumps ..............................
## Normal
## Jmu : 1
## Jsig : 0.5
## __________________ Distribution Approximant ____________________
## Density approx. : Saddlepoint
## Trunc. Order : 8
## Dens. Order : 4
## =================================================================
Lam1=function(t){0.2}
Lam2=function(t){0}
res2b=simulate()
resb=JGQD.density(Xs=4,Xt=seq(0,20,1/10),s=0,t=1.15,delt=1/100,factorize = TRUE)
##
## ================================================================
## Jump Generalized Quadratic Diffusion (JGQD)
## ================================================================
## _____________________ Drift Coefficients _______________________
## G0 : 2*5
## G1 : -2
## G2
## ___________________ Diffusion Coefficients _____________________
## Q0
## Q1 : 0.25
## Q2
## _______________________ Jump Mechanism _________________________
## ......................... Intensity ............................
## Lam0 : 0
## Lam1 : 0.2
## Lam2 : 0
## ........................... Jumps ..............................
## Normal
## Jmu : 1
## Jsig : 0.5
## __________________ Distribution Approximant ____________________
## Density approx. : Saddlepoint
## Trunc. Order : 8
## Dens. Order : 4
## =================================================================
pp1 = resa$zero_jump_prob
pp2 = resb$zero_jump_prob
#' Plot the evolution of the 0 jump probabilities
plot(pp1~resa$time,type='l',ylim=c(0,1),lwd=1,col='black',main='Probability of 0 Jump Occurrances',ylab=expression(P(N[t]-N[0] == 0)),xlab='t',axes=F)
lines(res2a$probs[1,]~res2a$time,col='blue',lty='dashed',lwd=2)
lines(pp2~resa$time,col='black',lty='solid',lwd=1)
lines(res2b$probs[1,]~res2b$time,col='blue',lty='dashed',lwd=2)
axis(1,at=seq(0,5,1/10))
axis(1,at=seq(0,5,1/10/10),tcl=-0.2,labels=NA)
axis(2,at=seq(0,1,1/10))
axis(2,at=seq(0,1,1/10/10),tcl=-0.2,labels=NA)
abline(h=c(0.5,0.5,0.5),lty='dotted',col='grey')
legend('topright',lty=c('solid','dashed'),lwd=c(2,2),col=c('black','blue'),legend=c('Moment Eqns.','Simulated'))
text(0.5,0.7,label=expression(lambda(X[t],t) == 0.2*X[t]),pos=4,cex=0.85)
text(0.25,0.25,label=expression(lambda(X[t],t) == 0.5*(1+sin(3*pi*t))*X[t]+0.1*(1+cos(3*pi*t))*X[t]^2),pos=4,cex=0.85)
# Evaluate the transition densities over short transition horizons:
TT=0.02
Lam1 = function(t){0.5*(1+sin(3*pi*t))}
Lam2 = function(t){0.1*(1+cos(3*pi*t))}
res2a=simulate(TT=TT,pts=seq(0.5*TT,TT,length=4))
resa=JGQD.density(Xs=4,Xt=seq(0,10,1/100),s=0,t=TT,delt=1/200,factorize = TRUE)
##
## ================================================================
## Jump Generalized Quadratic Diffusion (JGQD)
## ================================================================
## _____________________ Drift Coefficients _______________________
## G0 : 2*5
## G1 : -2
## G2
## ___________________ Diffusion Coefficients _____________________
## Q0
## Q1 : 0.25
## Q2
## _______________________ Jump Mechanism _________________________
## ......................... Intensity ............................
## Lam0 : 0
## Lam1 : 0.5*(1+sin(3*pi*t))
## Lam2 : 0.1*(1+cos(3*pi*t))
## ........................... Jumps ..............................
## Normal
## Jmu : 1
## Jsig : 0.5
## __________________ Distribution Approximant ____________________
## Density approx. : Saddlepoint
## Trunc. Order : 8
## Dens. Order : 4
## =================================================================
hist(res2a$X,freq=F,col='white',breaks=100,main=paste0('Transition density at t = ',TT),axes=F,xlab='X_t',xlim=c(3.5,8))
lines(resa$density[,TT*200]~resa$Xt,col='blue',lwd=2)
axis(1,at=seq(3.5,8,1/2))
axis(1,at=seq(3.5,8,1/2/10),tcl=-0.2,labels=NA)
axis(2,at=seq(0,2.5,1/2))
axis(2,at=seq(0,2.5,1/2/10),tcl=-0.2,labels=NA)
TT=0.1
Lam1=function(t){0.2}
Lam2=function(t){0}
res2b=simulate(TT=TT)
resb=JGQD.density(Xs=4,Xt=seq(0,10,1/50),s=0,t=TT,delt=1/100,factorize = TRUE)
##
## ================================================================
## Jump Generalized Quadratic Diffusion (JGQD)
## ================================================================
## _____________________ Drift Coefficients _______________________
## G0 : 2*5
## G1 : -2
## G2
## ___________________ Diffusion Coefficients _____________________
## Q0
## Q1 : 0.25
## Q2
## _______________________ Jump Mechanism _________________________
## ......................... Intensity ............................
## Lam0 : 0
## Lam1 : 0.2
## Lam2 : 0
## ........................... Jumps ..............................
## Normal
## Jmu : 1
## Jsig : 0.5
## __________________ Distribution Approximant ____________________
## Density approx. : Saddlepoint
## Trunc. Order : 8
## Dens. Order : 4
## =================================================================
hist(res2b$X,freq=F,col='white',breaks=100,main=paste0('Transition density at t = ',TT)
,axes=F,xlab='X_t',xlim=c(3,8))
lines(resb$density[,TT*100]~resb$Xt,col='blue',lwd=2)
axis(1,at=seq(3,8,1/2))
axis(1,at=seq(3,8,1/2/10),tcl=-0.2,labels=NA)
axis(2,at=seq(0,1.5,1/4))
axis(2,at=seq(0,1.5,1/4/10),tcl=-0.2,labels=NA)
TT=0.1
Lam1=function(t){0.2}
Lam2=function(t){0}
Q1 =function(t){0.25}
Jsig = function(t){0.05}
res.sim=simulate(TT=TT,pts=seq(0.04,0.1,length=3),brks=55)
res =JGQD.density(Xs=4,Xt=seq(3,7,1/50),s=0,t=TT,delt=1/200,factorize = TRUE)
##
## ================================================================
## Jump Generalized Quadratic Diffusion (JGQD)
## ================================================================
## _____________________ Drift Coefficients _______________________
## G0 : 2*5
## G1 : -2
## G2
## ___________________ Diffusion Coefficients _____________________
## Q0
## Q1 : 0.25
## Q2
## _______________________ Jump Mechanism _________________________
## ......................... Intensity ............................
## Lam0 : 0
## Lam1 : 0.2
## Lam2 : 0
## ........................... Jumps ..............................
## Normal
## Jmu : 1
## Jsig : 0.05
## __________________ Distribution Approximant ____________________
## Density approx. : Saddlepoint
## Trunc. Order : 8
## Dens. Order : 4
## =================================================================
library(rgl)
um = rbind(
c(-0.8326439,0.5528952,-0.03179577,0),
c(-0.1512481,-0.1717941,0.97345304,0),
c(0.5327552,0.8153488,0.22666772,0),
c(0.0000000,0.0000000,0.00000000,1))
r3dDefaults$userMatrix =um
open3d(windowRect=c(0,0,360*1.5,360*1.5)+30)
## wgl
## 1
persp3d(res$Xt,res$time,pmax(pmin(res$density,3.5),0),col='white',alpha=0.5,box=F,
xlab='Xt',ylab='Time',zlab='')
surface3d(res$Xt,res$time[1:8],pmax(pmin(res$density[,1:8],3.5),0),col='white')
cols=colorRampPalette(c("red", "yellow"))
for(i in 1:length(res.sim$pts))
{
h1 =res.sim$hists[[i]]
y=rep(h1$density,each=2)
x=c(rbind(h1$breaks[-length(h1$breaks)],h1$breaks[-1]))
hd=cbind(0,y,0)
tt=res.sim$pts[i]
surface3d(x,c(tt-0.0001,tt,tt+0.0001),hd,col=cols(5)[i],alpha=1)
lines3d(res$Xt,tt,res$density[,tt*200],col='black',lwd=2)
}
rgl.snapshot('temp.png')
library(png)
imag = readPNG(paste0(getwd(),'/temp.png'))
plot(1:2, type='n', main="", xlab="", ylab="",axes=FALSE)
lim <- par()
rasterImage(imag, lim$usr[1], lim$usr[3], lim$usr[2], lim$usr[4])
See also:
JGQD.remove()
## [1] "Removed : G0 G1 Q1 Lam0 Lam1 Lam2 Jmu Jsig"
theta=c(0.5,5,-0.1,0.4,0.4,6,-0.1,0.3,1,0.75,0.75,0.75,0.75)
a00 = function(t){theta[1]*theta[2]}
a10 = function(t){-theta[1]}
a01 = function(t){theta[3]}
c10 = function(t){theta[4]^2}
b00 = function(t){theta[5]*theta[6]}
b01 = function(t){-theta[5]}
b10 = function(t){theta[7]}
f01 = function(t){theta[8]^2}
Lam00= function(t){theta[9]}
Jmu1=function(t){theta[10]*(1+sin(2*pi*t))}
Jmu2=function(t){theta[11]*(1+sin(2*pi*t))}
Jsig11=function(t){theta[12]^2*(1+0.8*sin(2*pi*t))^2}
Jsig22=function(t){theta[13]^2*(1+0.8*sin(2*pi*t))^2}
xx=seq(3,11,1/10)
yy=seq(3,11,1/10)
res= BiJGQD.density(7,7,xx,yy,0,1,1/100,Dtype='Saddlepoint')
##
## ================================================================
## GENERALIZED QUADRATIC DIFFUSON
## ================================================================
## _____________________ Drift Coefficients _______________________
## a00 : theta[1]*theta[2]
## a10 : -theta[1]
## a01 : theta[3]
## ... ... ... ... ... ... ... ... ... ... ...
## b00 : theta[5]*theta[6]
## b10 : theta[7]
## b01 : -theta[5]
## ___________________ Diffusion Coefficients _____________________
## c10 : theta[4]^2
## ... ... ... ... ... ... ... ... ... ... ...
## ... ... ... ... ... ... ... ... ... ... ...
## ... ... ... ... ... ... ... ... ... ... ...
## f01 : theta[8]^2
## _______________________ Jump Components ________________________
## ......................... Intensity ............................
## Lam00 : theta[9]
## ........................... Jumps ..............................
## Jmu1 : theta[10]*(1+sin(2*pi*t))
## Jmu2 : theta[11]*(1+sin(2*pi*t))
## Jsig11 : theta[12]^2*(1+0.8*sin(2*pi*t))^2
## Jsig22 : theta[13]^2*(1+0.8*sin(2*pi*t))^2
## =================================================================
# Simulate the process
mux = function(x,y,t){a00(t)+a10(t)*x+a01(t)*y}
sigmax = function(x,y,t){sqrt(c10(t)*x)}
muy = function(x,y,t){b00(t)+b10(t)*x+b01(t)*y}
sigmay = function(x,y,t){sqrt(f01(t)*y)}
lambda1 = function(x,y,t){Lam00(t)}
lambda2 = function(x,y,t){rep(0,length(x))}
j11 = function(x,y,z){z}
j12 = function(x,y,z){z}
j21 = function(x,y,z){z}
j22 = function(x,y,z){z}
simulate=function(x0=7,y0=7,N=10000,TT=5,delta=1/1000,pts,brks=30,plt=F)
{
library(colorspace)
colpal=function(n){rev(sequential_hcl(n,power=0.8,l=c(40,100)))}
d=0 # Time index
tt=seq(0,TT,delta) # Time sequance
X=rep(x0,N) # Initialize state vectors
Y=rep(y0,N)
x.traj = rep(x0,length(tt))
y.traj = rep(y0,length(tt))
x.jump = rep(0,length(tt))
y.jump = rep(0,length(tt))
# Storage for histogram snapshots:
count = 1
L1=list()
L2=list()
evts = rep(0,N)
for(i in 2:length(tt))
{
X=X+mux(X,Y,d)*delta+sigmax(X,Y,d)*rnorm(N,sd=sqrt(delta))
Y=Y+muy(X,Y,d)*delta+sigmay(X,Y,d)*rnorm(N,sd=sqrt(delta))
events1 = (lambda1(X,Y,d)*delta>runif(N))
if(any(events1))
{
wh=which(events1)
evts[wh]=evts[wh]+1
X[wh]=X[wh]+j11(X[wh],Y[wh],rnorm(length(wh),Jmu1(d),sqrt(Jsig11(d))))
Y[wh]=Y[wh]+j21(X[wh],Y[wh],rnorm(length(wh),Jmu2(d),sqrt(Jsig22(d))))
}
events2 = (lambda2(X,Y,d)*delta>runif(N))
d=d+delta
if(sum(round(pts,3)==round(d,3))!=0)
{
if(plt)
{
expr1 = expression(X_t)
expr2 = expression(Y_t)
color.palette=colorRampPalette(c('green','blue','red'))
filled.contour(res$Xt,res$Yt,res$density[,,i],
main=paste0('Transition Density \n (t = ',round(d,2),')'),
color.palette=colpal,
nlevels=41,xlab=expression(X[t]),ylab=expression(Y[t]),plot.axes=
{
# Add simulated trajectories
points(Y~X,pch=c(20,3)[(evts>0)+1],col=c('black','red')[(evts>0)+1],cex=c(0.9,0.6)[(evts>0)+1])
if(any(events2))
{
wh=which(events2)
segments(xpreee[wh],ypreee[wh],X[wh],Y[wh],col='gray')
}
axis(1);axis(2);
# Add a legend
legend('topright',col=c('black','red'),pch=c(20,3),
legend=c('Simulated Trajectories','Jumped'))
yy=contourLines(res$Xt,res$Yt,res$density[,,i],levels=seq(0.01,0.1,length=10))
if(length(yy)>0)
{
for(j in 1:length(yy))
{
lines(yy[[j]])
}
}
})
}
L1[[count]] = hist(X,plot=F,breaks=brks)
L2[[count]] = hist(Y,plot=F,breaks=brks)
count=count+1
#savePlot(paste0('BiExampleTD',count,'.pdf'),type='pdf')
}
}
return(list(time=tt,histsx=L1,histsy=L2,pts=pts))
}
sim=simulate(7,7,N=200,TT=0.75,delta=1/100,plt=T,pts=c(0.13,0.28,0.38,0.51,0.63,0.75))
See also:
JGQD.remove()
## [1] "Removed : a00 a10 a01 b00 b10 b01 c10 f01 Lam00 Jmu1 Jmu2 Jsig11 Jsig22"
theta=c(0.1,0.5,0.5,0.2,0.25)
# Define the jump diffusion using the DiffusionRjgqd syntax:
G0=function(t){theta[1]}
Q0=function(t){theta[2]^2}
# State dependent intensity:
Lam0 = function(t){theta[3]}
Jmu = function(t){theta[4]}
Jsig = function(t){theta[5]}
res_1 = JGQD.density(0,seq(-2,2,1/100),0,1,1/100,factorize=T,Jdist='Normal',Dtype='Normal.A')
##
## ================================================================
## Jump Generalized Quadratic Diffusion (JGQD)
## ================================================================
## _____________________ Drift Coefficients _______________________
## G0 : theta[1]
## G1
## G2
## ___________________ Diffusion Coefficients _____________________
## Q0 : theta[2]^2
## Q1
## Q2
## _______________________ Jump Mechanism _________________________
## ......................... Intensity ............................
## Lam0 : theta[3]
## Lam1
## Lam2
## ........................... Jumps ..............................
## Normal
## Jmu : theta[4]
## Jsig : theta[5]
## __________________ Distribution Approximant ____________________
## Density approx. : Normal.A
## Trunc. Order : 8
## Dens. Order : 4
## =================================================================
true.density=function(x,y,t,theta,order =1)
{
mu = theta[1]
sig = theta[2]
lam = theta[3]
mu2 = theta[4]
sig2 = theta[5]
dens=1/sqrt(2*pi*sig^2*t)*exp(-(y-x)^2/(2*sig^2*t)+mu/sig^2*(y-x))*exp(-(mu^2/(2*sig^2)+lam)*t)#*(1-(mu^2/(2*sig^2)+lam)*t)+lam/sqrt(2*pi*sig2^2)*exp(-(y-x-mu2)^2/(2*sig2^2))
if(order>=1){dens= dens +exp(-lam*t)*lam/(sqrt(2*pi)*sqrt(sig^2*t+sig2^2))*exp(-(y-x-mu*t-mu2)^2/(2*(sig^2*t+sig2^2)))*t}
if(order>=2){dens= dens +exp(-lam*t)*lam^2/(2*sqrt(2*pi)*sqrt(sig^2*t+2*sig2^2))*exp(-(y-x-mu*t-2*mu2)^2/(2*(sig^2*t+2*sig2^2)))*t^2}
if(order>=3){
for(j in 3:order)
dens= dens +exp(-lam*t)*lam^j/(factorial(j)*sqrt(2*pi)*sqrt(sig^2*t+j*sig2^2))*exp(-(y-x-mu*t-j*mu2)^2/(2*(sig^2*t+j*sig2^2)))*t^j
}
return(list(density=dens,Xt=y))
}
herm.density=function(x,y,t,theta,order =1)
{
mu = theta[1]
sig = theta[2]
lam = theta[3]
mu2 = theta[4]
sig2 = theta[5]
if(order == 1)
{
dens=1/sqrt(2*pi*sig^2*t)*exp(-(y-x)^2/(2*sig^2*t)+mu/sig^2*(y-x))*exp(-(mu^2/(2*sig^2)+lam)*t)*(1-(mu^2/(2*sig^2)+lam)*t)+lam/sqrt(2*pi*sig2^2)*exp(-(y-x-mu2)^2/(2*sig2^2))*t
}
if(order == 2)
{
t1 = 1-(mu^2/(2*sig^2)+lam)*t+(mu^2/(2*sig^2)+lam)^2*t^2/2
t2 = (exp((x*y)/sig2^2)*exp((mu2*y)/sig2^2)*sqrt(pi)*sqrt(2)*lam)/(2*exp(y^2/(2*sig2^2))*exp(x^2/(2*sig2^2))*exp((mu2*x)/sig2^2)*exp(mu2^2/(2*sig2^2))*sig2*pi)-(((exp((x*y)/sig2^2)*exp((mu2*y)/sig2^2)*sqrt(pi)*sqrt(2)*sig2^2+(-exp((x*y)/sig2^2)*exp((mu2*y)/sig2^2)*1*mu2^2+(-2*exp((x*y)/sig2^2)*exp((mu2*y)/sig2^2)*x+2*exp((x*y)/sig2^2)*exp((mu2*y)/sig2^2)*y)*1*mu2+(-exp((x*y)/sig2^2)*exp((mu2*y)/sig2^2)*x^2+2*exp((x*y)/sig2^2)*exp((mu2*y)/sig2^2)*y*x-exp((x*y)/sig2^2)*exp((mu2*y)/sig2^2)*y^2)*1)*sqrt(pi)*sqrt(2))*lam*sig^2-2*exp((x*y)/sig2^2)*exp((mu2*y)/sig2^2)*1*sqrt(pi)*sqrt(2)*sig2^4*lam^2+(2*exp((x*y)/sig2^2)*exp((mu2*y)/sig2^2)*mu*1*mu2+(2*exp((x*y)/sig2^2)*exp((mu2*y)/sig2^2)*x-2*exp((x*y)/sig2^2)*exp((mu2*y)/sig2^2)*y)*mu*1)*sqrt(pi)*sqrt(2)*sig2^2*lam)*t)/(4*exp(y^2/(2*sig2^2))*exp(x^2/(2*sig2^2))*exp((mu2*x)/sig2^2)*exp(mu2^2/(2*sig2^2))*sig2^5*pi)
t3 = exp(-lam*0)*lam^2/(2*sqrt(2*pi)*sqrt(sig^2*0+2*sig2^2))*exp(-(y-x-mu*0-2*mu2)^2/(2*(sig^2*0+2*sig2^2)))
dens=1/sqrt(2*pi*sig^2*t)*exp(-(y-x)^2/(2*sig^2*t)+mu/sig^2*(y-x))*exp(-(mu^2/(2*sig^2)+lam)*t)*(t1)+t2+t3
}
if(order ==3)
{
dens=1/sqrt(2*pi*sig^2*t)*exp(-(y-x)^2/(2*sig^2*t)+mu/sig^2*(y-x))*exp(-(mu^2/(2*sig^2)+lam)*t)*(1-lam*t)+lam*t/sqrt(2*pi*sig2^2)*exp(-(y-x-mu2)^2/(2*sig2^2))
}
return(list(density=dens,Xt=y))
}
#================================ Short time ======================================================
ind=10
res_2 = true.density(0,res_1$Xt,ind*1/100,theta,order=0)
res_3 = true.density(0,res_1$Xt,ind*1/100,theta,order=1)
res_4 = true.density(0,res_1$Xt,ind*1/100,theta,order=2)
res_5 = true.density(0,res_1$Xt,ind*1/100,theta,order=10)
res_6 = herm.density(0,res_1$Xt,ind*1/100,theta,order=1)
res_7 = herm.density(0,res_1$Xt,ind*1/100,theta,order=3)
order = c(1,6,7,2,3,4,5)
expr1 = expression(f[GQD]^{(4)})
expr2 = expression(f[true]^{(0)})
expr3 = expression(f[true]^{(1)})
expr4 = expression(f[true]^{(2)})
expr5 = expression(f[true]^{(10)})
expr6 = expression(f[Yu]^{(1)})
expr7 = expression(f[Yu]^{(R)})
eprs =c(expr1,expr2,expr3,expr4,expr5,expr6,expr7)
ltys = c('solid','dotted','dashed','dotdash','solid','solid','dashed') #'#1B7837','#5AAE61'
cols = c('blue','black','black','black','black','#ACD39E','#5AAE61')
lwds = c(2,1,1,1,1,1,2)
pchs= c(16,NA,NA,NA,NA,3,4)
#par(mfrow=c(1,2))
thin=seq(1,length(res_1$Xt),10)
plot((res_1$density[,ind])~res_1$Xt,type='l',col=cols[1],lty=ltys[1],lwd=lwds[1],
main=paste0('Brownian motion with drift (t = ',round(ind*1/100,2),')'),xlab='X_t',
ylab='Density',las=1,xlim=c(-1/1.5,1/1.5))
points((res_1$density[thin,ind])~res_1$Xt[thin],col=cols[1],pch=16,cex=0.9)
lines((res_2$density)~res_2$Xt,col=cols[2],lty=ltys[2],lwd=lwds[2])
lines((res_3$density)~res_3$Xt,col=cols[3],lty=ltys[3],lwd=lwds[3])
lines((res_4$density)~res_4$Xt,col=cols[4],lty=ltys[4],lwd=lwds[4])
lines((res_5$density)~res_5$Xt,col=cols[5],lty=ltys[5],lwd=lwds[5])
lines((res_6$density)~res_6$Xt,col=cols[6],lty=ltys[6],lwd=lwds[6])
points((res_6$density[thin])~res_6$Xt[thin],col=cols[6],pch=3,cex=0.9)
lines((res_7$density)~res_7$Xt,col=cols[7],lty=ltys[7],lwd=lwds[7])
points((res_7$density[thin])~res_7$Xt[thin],col=cols[7],pch=4,cex=0.9)
legend('topright',legend=eprs[order],lty=ltys[order],lwd=lwds[order],col=cols[order],pch=pchs[order],bty='n')
#================================ Long time ======================================================
ind=100
res_2 = true.density(0,res_1$Xt,ind*1/100,theta,order=0)
res_3 = true.density(0,res_1$Xt,ind*1/100,theta,order=1)
res_4 = true.density(0,res_1$Xt,ind*1/100,theta,order=2)
res_5 = true.density(0,res_1$Xt,ind*1/100,theta,order=10)
res_6 = herm.density(0,res_1$Xt,ind*1/100,theta,order=1)
res_7 = herm.density(0,res_1$Xt,ind*1/100,theta,order=3)
order = c(1,6,7,2,3,4,5)
expr1 = expression(f[GQD]^{(4)})
expr2 = expression(f[true]^{(0)})
expr3 = expression(f[true]^{(1)})
expr4 = expression(f[true]^{(2)})
expr5 = expression(f[true]^{(10)})
expr6 = expression(f[Yu]^{(1)})
expr7 = expression(f[Yu]^{(R)})
eprs =c(expr1,expr2,expr3,expr4,expr5,expr6,expr7)
ltys = c('solid','dotted','dashed','dotdash','solid','solid','dashed')
cols = c('blue','black','black','black','black','#ACD39E','#5AAE61')
lwds = c(2,1,1,1,1,1,2)
pchs= c(16,NA,NA,NA,NA,3,4)
thin=seq(1,length(res_1$Xt),20)
plot((res_1$density[,ind])~res_1$Xt,type='l',col=cols[1],lty=ltys[1],lwd=lwds[1],
main=paste0('Brownian motion with drift (t = ',round(ind*1/100,2),')'),xlab='X_t',
ylab='Density',las=1)
points((res_1$density[thin,ind])~res_1$Xt[thin],col=cols[1],pch=16,cex=0.9)
lines((res_2$density)~res_2$Xt,col=cols[2],lty=ltys[2],lwd=lwds[2])
lines((res_3$density)~res_3$Xt,col=cols[3],lty=ltys[3],lwd=lwds[3])
lines((res_4$density)~res_4$Xt,col=cols[4],lty=ltys[4],lwd=lwds[4])
lines((res_5$density)~res_5$Xt,col=cols[5],lty=ltys[5],lwd=lwds[5])
lines((res_6$density)~res_6$Xt,col=cols[6],lty=ltys[6],lwd=lwds[6])
points((res_6$density[thin])~res_6$Xt[thin],col=cols[6],pch=3,cex=0.9)
lines((res_7$density)~res_7$Xt,col=cols[7],lty=ltys[7],lwd=lwds[7])
points((res_7$density[thin])~res_7$Xt[thin],col=cols[7],pch=4,cex=0.9)
legend('topright',legend=eprs[order],lty=ltys[order],lwd=lwds[order],col=cols[order],pch=pchs[order],bty='n')
Note: the characteristic_function_to_density ()
was adapted from an excellent post by Vincent Zoonekynd.
#=========================================================
# Evaluate the transition density at time tau =0.25 using
# the characteristic function
#=========================================================
# Some peripheral parameters:
th = c(1,5,0.15,0.5,0.5)
tau = 0.25
x0 = 4
# From CF to the appr. density:
characteristic_function_to_density = function(phi,n,a,b)
{
i = 0:(n-1)
dx = (b-a)/n
x = seq(a,b-dx,length =n)
dt = 2*pi / ( n * dx )
c = -n/2 * dt
d = n/2 * dt
t = c + i * dt
phi_t = phi(t)
X = exp(-(0+1i)*i*dt*a)*phi_t
Y = fft(X)
density = dt /(2*pi)*exp(-(0+1i)*c*x)*Y
list(x = x,density = Re(density))
}
# The characteristic function:
f =function(t,theta =th)
{
a = theta[1]
b = theta[2]
sigma = theta[3]
d = 1/theta[4]
cc = theta[5]
#tau =1.0
t=(0+1i)*t
term1 = (1-sigma^2/(2*a)*t*(1-exp(-a*tau)))^(-2*a*b/sigma^2)
term2 = ((d-sigma^2*d*t/(2*a)+(sigma^2*d/(2*a)-1)*t*exp(-a*tau))/(d-t))^(cc/(a-sigma^2*d/2))
term3 = exp(x0*t*exp(-a*tau)/(1-sigma^2/(2*a)*t*(1-exp(-a*tau))))
rs=term1*term2*term3
return(rs)
}
d <-characteristic_function_to_density(f,2^10,1,10)
JGQD.remove()
## [1] "Removed : G0 Q0 Lam0 Jmu Jsig"
G0=function(t){th[1]*th[2]}
G1=function(t){-th[1]}
Q1=function(t){th[3]^2}
Lam0 =function(t){th[4]}
Jlam =function(t){th[5]}
res_1=JGQD.density(4,d$x,0,5,delt=1/100,Jdist='Exponential',factorize=TRUE)
##
## ================================================================
## Jump Generalized Quadratic Diffusion (JGQD)
## ================================================================
## _____________________ Drift Coefficients _______________________
## G0 : th[1]*th[2]
## G1 : -th[1]
## G2
## ___________________ Diffusion Coefficients _____________________
## Q0
## Q1 : th[3]^2
## Q2
## _______________________ Jump Mechanism _________________________
## ......................... Intensity ............................
## Lam0 : th[4]
## Lam1
## Lam2
## ........................... Jumps ..............................
## Exponential
## Jlam : th[5]
## __________________ Distribution Approximant ____________________
## Density approx. : Saddlepoint
## Trunc. Order : 8
## Dens. Order : 4
## =================================================================
res_2=JGQD.density(4,d$x,0,5,delt=1/100,Jdist='Exponential',factorize=FALSE)
##
## ================================================================
## Jump Generalized Quadratic Diffusion (JGQD)
## ================================================================
## _____________________ Drift Coefficients _______________________
## G0 : th[1]*th[2]
## G1 : -th[1]
## G2
## ___________________ Diffusion Coefficients _____________________
## Q0
## Q1 : th[3]^2
## Q2
## _______________________ Jump Mechanism _________________________
## ......................... Intensity ............................
## Lam0 : th[4]
## Lam1
## Lam2
## ........................... Jumps ..............................
## Exponential
## Jlam : th[5]
## __________________ Distribution Approximant ____________________
## Density approx. : Saddlepoint
## Trunc. Order : 8
## Dens. Order : 4
## =================================================================
#par(mfrow=c(1,2))
xlims= c(3.5,5.5)
ylims= c(0,2.8)
cols= c(1,'blue','purple')
ltys= c('solid','dashed','dotdash')
lwds = c(1,1,1)
pchs= c(NA,16,17)
thin=seq(1,length(res_1$Xt),25)
eprs =c(
'Fourier',
'Saddlepoint (Factorized)',
'Saddlepoint (Unfactorized)')
plot(d$x,(d$density),type='l',axes=F ,col=cols[1],lty=ltys[1],lwd=lwds[1],xlim=xlims,ylim=ylims,
ylab='Density',xlab='X_t', main=paste0('BAJD transition density (t = ',tau,')'))
lines(res_1$density[,100*tau]~res_1$Xt ,col=cols[2],lty=ltys[2],lwd=lwds[2])
points(res_1$density[thin,100*tau]~res_1$Xt[thin],col=cols[2],pch=pchs[2])
lines (res_2$density[,100*tau]~res_2$Xt,col=cols[3],lty=ltys[3],lwd=lwds[3])
points(res_2$density[thin,100*tau]~res_2$Xt[thin],col=cols[3],pch=pchs[3])
legend('topright',legend=eprs,lty=ltys,lwd=lwds,col=cols,pch=pchs,bty='n')
axis(2,at=seq(ylims[1],ylims[2],0.5))
axis(2,at=seq(ylims[1],ylims[2],0.5/4),labels=NA,tcl=-0.2)
axis(1,at=seq(xlims[1],xlims[2],0.5))
axis(1,at=seq(xlims[1],xlims[2],0.5/4),labels=NA,tcl=-0.2)
cd=cumsum(d$density*diff(d$x)[1])
qs=c(0.001,0.01,0.99,0.999)
vals= qs*0
for(i in 1:length(qs))
{
dfs=abs(cd - qs[i])
wh= which.min(dfs)
vals[i] = d$x[wh]
}
segments(vals,-0.1,vals,0.0,lty='solid',col='black')
abline(h =0,lty='solid')
# Evaluate on shorter transition horizon:
tau = 0.05
d <-characteristic_function_to_density(f,2^10,1,10)
xlims= c(3.5,5.5)
ylims= c(0,6)
cols= c(1,'blue','purple')
ltys= c('solid','dashed','dotdash')
lwds = c(1,1,1)
pchs= c(NA,16,17)
thin=seq(1,length(res_1$Xt),25)
eprs =c(
'Fourier',
'Saddlepoint (Factorized)',
'Saddlepoint (Unfactorized)')
plot(d$x,(d$density),type='l',axes=F ,col=cols[1],lty=ltys[1],lwd=lwds[1],xlim=xlims,ylim=ylims,
ylab='Density',xlab='X_t', main=paste0('BAJD transition density (t = ',tau,')'))
lines(res_1$density[,100*tau]~res_1$Xt ,col=cols[2],lty=ltys[2],lwd=lwds[2])
points(res_1$density[thin,100*tau]~res_1$Xt[thin],col=cols[2],pch=pchs[2])
lines (res_2$density[,100*tau]~res_2$Xt,col=cols[3],lty=ltys[3],lwd=lwds[3])
points(res_2$density[thin,100*tau]~res_2$Xt[thin],col=cols[3],pch=pchs[3])
legend('topright',legend=eprs,lty=ltys,lwd=lwds,col=cols,pch=pchs,bty='n')
axis(2,at=seq(ylims[1],ylims[2],0.5))
axis(2,at=seq(ylims[1],ylims[2],0.5/4),labels=NA,tcl=-0.2)
axis(1,at=seq(xlims[1],xlims[2],0.5))
axis(1,at=seq(xlims[1],xlims[2],0.5/4),labels=NA,tcl=-0.2)
cd=cumsum(d$density*diff(d$x)[1])
qs=c(0.001,0.01,0.99,0.999)
vals= qs*0
for(i in 1:length(qs))
{
dfs=abs(cd - qs[i])
wh= which.min(dfs)
vals[i] = d$x[wh]
}
segments(vals,-0.1,vals,0.0,lty='solid',col='black')
abline(h =0,lty='solid')
data(JSDEsim2)
attach(JSDEsim2)
data(JSDEsim3)
attach(JSDEsim3)
#------------------------------------------------------------------------------
# Define parameterized coefficients of the process, and set up starting
# parameters.
# True model: dX_t = 0.5(2+Y_t-X_t)dt+0.1sqrt{X_tY_t}dB_t +dP_t^1
# dX_t = 1(5-Y_t)dt+0.1sqrt{X_t}dW_t +dP_t^2
# where dP_t^1 = z_tdN_t, dP_t^1 = z_tdN_t describes a Poisson
# process with intensity:
# lambda(X_t,Y_t) = 1
# and
# {z_1,z_2}' ~ Bivariate Normal({0.5,0.5}',diag({0.5,0.5}'))
#------------------------------------------------------------------------------
par(mfrow=c(1,1))
plot(Xt~time,type='l',col='#BBCCEE',ylim=c(-3,13),xlim=c(0,60),axes=F,main='Simulated Trajectory',xlab = 'Time',ylab ='X_t')
lines(Yt~time,type='l',col='#222299')
axis(1,at=seq(0,50,5))
axis(1,at=seq(0,50,5/5),tcl=-0.2,labels=NA)
axis(2,at=seq(-3,13,1))
axis(2,at=seq(-3,13,1/5),tcl=-0.2,labels=NA)
lines(Xjumps[Xjumps!=0]~Jtime[Xjumps!=0],type='h',col='#BBCCEE')
lines(Yjumps[Yjumps!=0]~Jtime[Yjumps!=0],type='h',col='#222299')
mx=mean(Xjumps[Xjumps!=0])
sx=sd(Xjumps[Xjumps!=0])
my=mean(Yjumps[Yjumps!=0])
sy=sd(Yjumps[Yjumps!=0])
legend('topright',lty=c(1,2),col=c('#BBCCEE','#222299'),legend=c(expr1,expr2),cex=0.9)
segments(50,-5,50,9,lty='dotted')
xx=seq(-3,3,1/10)
yy=dnorm(xx,mx,sx)
yy = (yy-min(yy))/(max(yy)-min(yy))*9+51*1
lines(xx~yy,col='#BBCCEE')
yy=dnorm(xx,my,sy)
yy = (yy-min(yy))/(max(yy)-min(yy))*9+51*1
lines(xx~yy,col='#222299')
text(55,10.0,substitute(hat(theta)[8]==a,list(a=round(mx,2))),cex=0.8)
text(55,9.0,substitute(hat(theta)[9]==a,list(a=round(sx,2))),cex=0.8)
text(55,8.0,substitute(hat(theta)[10]==a,list(a=round(my,2))),cex=0.8)
text(55,7.0,substitute(hat(theta)[11]==a,list(a=round(sy,2))),cex=0.8)
abline(h=0,lty='dotted')
X=cbind(Xt,Yt)
# Define the model:
JGQD.remove()
a00 <-function(t){theta[1]*theta[2]}
a10 <-function(t){-theta[1]}
a01 <-function(t){theta[1]}
c11 <-function(t){theta[3]*theta[3]}
b00 <-function(t){theta[4]*theta[5]}
b01 <-function(t){-theta[4]}
f01 <-function(t){theta[6]*theta[6]}
# Constant intensity
Lam00= function(t){theta[7]}
# Normal jumps:
Jmu1 <-function(t){theta[8]}
Jmu2 <-function(t){theta[9]}
Jsig11 <-function(t){theta[10]*theta[10]}
Jsig22 <-function(t){theta[11]*theta[11]}
# Some starting parameters:
theta <-c(rep(1,11))
sds <-c(0.08,0.22,0.01,0.04,0.16,0.01,0.10,0.07,0.09,0.05,0.09)/2
burns <-10000
updates<-50000
res <-BiJGQD.mcmc(X,time,mesh=10,theta,sds,updates,burns=burns)
JGQD.estimates(res,thin=200,burns)[,1:3]
See also:
library(DiffusionRjgqd)
library(Quandl)
library(coda)
# Source data for the IBM VIX.
quandldata1 <- Quandl("CBOE/VXGOG", collapse="weekly",
start_date="2010-03-11",end_date="2015-07-01", type="raw")
Vt <- rev(quandldata1[,names(quandldata1)=='Close'])
time1 <-rev(quandldata1[,names(quandldata1)=='Date'])
plot(Vt~time1,type='l',col='#222299',ylim=c(10,50),main='Google Equity VIX (VXGOG)',xlab = 'Time',ylab ='Volatility %',lwd=1)
X <- Vt
time <- cumsum(c(0,diff(as.Date(time1))*(1/365)))
updates = 110000
burns = 10000
library(DiffusionRgqd)
windows(record=TRUE)
#========================================================================================
# CIR type models
#========================================================================================
GQD.remove()
G0 = function(t){theta[1]*theta[2]}
G1 = function(t){-theta[1]}
Q1 = function(t){theta[3]*theta[3]}
priors=function(theta){dunif(theta[1],0,100)}
theta = c(3,20,1)
sds = c(1.80,1.69,0.29)
model_1.1 = GQD.mcmc(X,time,10,theta,sds,updates,burns)
GQD.remove()
G0 = function(t){theta[1]*(theta[2]+theta[4]*sin(8*pi*t)+theta[5]*cos(8*pi*t))}
G1 = function(t){-theta[1]}
Q1 = function(t){theta[3]*theta[3]}
priors=function(theta){dunif(theta[1],0,100)}
theta = c(3,20,1,0.1,0.1)
sds = c(2.81,1.11,0.23,1.35,3.30)
model_1.2 = GQD.mcmc(X,time,10,theta,sds,updates,burns)
JGQD.remove()
G0 = function(t){theta[1]*theta[2]}
G1 = function(t){-theta[1]}
Q1 = function(t){theta[3]*theta[3]}
Lam0= function(t){theta[4]}
Jmu = function(t){theta[5]}
Jsig = function(t){theta[6]}
priors=function(theta){dunif(theta[1],0,100)*dunif(theta[4],0,100)*dunif(theta[6],0,100)}
theta = c(3,20,1,0.1,0.1,0.1)
sds = c(1.80,1.69,0.29,3.05,2.16,2.0)/1.5
model_1.3 = JGQD.mcmc(X,time,10,theta,sds,updates,burns)
JGQD.remove()
G0 = function(t){theta[1]*theta[2]}
G1 = function(t){-theta[1]}
Q1 = function(t){theta[3]*theta[3]}
Lam0= function(t){theta[4]}
Ja = function(t){theta[5]}
Jb = function(t){theta[6]}
priors=function(theta){dunif(theta[1],0,100)*dunif(theta[4],0,100)*dunif(theta[6],0,100)}
theta = c(5,20,1,0.1,0.0,0.1)
sds = c(1.87,2.92,0.32,4.07,0.31,0.42)/1.5
model_1.4 = JGQD.mcmc(X,time,10,theta,sds,updates,burns,Jdist='Laplace')
mc = mcmc(model_1.5$par.matrix)
round( summary(window(mc,burns,updates,50))[[1]][,2],2)
JGQD.remove()
G0 = function(t){theta[1]*(theta[2]+theta[7]*sin(2*pi*t*4)+theta[8]*cos(2*pi*t*4))}
G1 = function(t){-theta[1]}
Q2 = function(t){theta[3]*theta[3]}
Lam0= function(t){theta[4]}
Jmu = function(t){theta[5]}
Jsig = function(t){theta[6]}
priors=function(theta){dunif(theta[1],0,100)*dunif(theta[4],0,100)*dunif(theta[6],0,100)}
theta = c(3,20,0.5,0.1,0.1,0.1,2,2)
sds = c(1.88,5.04,0.05,3.58,2.23,1.44,2,2)/1.5
model_1.5 = JGQD.mcmc(X,time,10,theta,sds,updates,burns)
JGQD.remove()
G0 = function(t){theta[1]*(theta[2]+theta[7]*sin(2*pi*t*4)+theta[8]*cos(2*pi*t*4))}
G1 = function(t){-theta[1]}
Q2 = function(t){theta[3]*theta[3]}
Lam0= function(t){theta[4]}
Ja = function(t){theta[5]}
Jb = function(t){theta[6]}
priors=function(theta){dunif(theta[1],0,100)*dunif(theta[4],0,100)*dunif(theta[6],0,100)}
theta = c(3,20,0.5,0.1,0.0,0.1,2,2)
sds = c(1.54,1.38,0.07,5.28,0.28,0.4,2,2)/1.5
model_1.6 = JGQD.mcmc(X,time,10,theta,sds,updates,burns,Jdist='Laplace')
#========================================================================================
# Increased state-dependent volatility
#========================================================================================
GQD.remove()
G0 = function(t){theta[1]*theta[2]}
G1 = function(t){-theta[1]}
Q2 = function(t){theta[3]*theta[3]}
priors=function(theta){dunif(theta[1],0,100)}
theta = c(3,20,1)
sds = c(1.80,1.69,0.29)
model_2.1 = GQD.mcmc(X,time,10,theta,sds,updates,burns)
GQD.remove()
G0 = function(t){theta[1]*(theta[2]+theta[4]*sin(8*pi*t)+theta[5]*cos(8*pi*t))}
G1 = function(t){-theta[1]}
Q2 = function(t){theta[3]*theta[3]}
priors=function(theta){dunif(theta[1],0,100)}
theta = c(3,20,1,0.1,0.1)
sds = c(2.81,1.11,0.23,1.35,3.30)
model_2.2 = GQD.mcmc(X,time,10,theta,sds,updates,burns)
JGQD.remove()
G0 = function(t){theta[1]*theta[2]}
G1 = function(t){-theta[1]}
Q2 = function(t){theta[3]*theta[3]}
Lam0= function(t){theta[4]}
Jmu = function(t){theta[5]}
Jsig = function(t){theta[6]}
priors=function(theta){dunif(theta[1],0,100)*dunif(theta[3],0,100)*dunif(theta[4],0,100)*dunif(theta[6],0,100)}
theta = c(3,20,1,0.1,0.1,0.1)
sds = c(1.84,1.85,0.05,1.66,1.95,0.93)/1
model_2.3 = JGQD.mcmc(X,time,10,theta,sds,updates,burns)
JGQD.remove()
G0 = function(t){theta[1]*theta[2]}
G1 = function(t){-theta[1]}
Q2 = function(t){theta[3]*theta[3]}
Lam0= function(t){theta[4]}
Ja = function(t){theta[5]}
Jb = function(t){theta[6]}
priors=function(theta){dunif(theta[1],0,100)*dunif(theta[3],0,100)*dunif(theta[4],0,100)*dunif(theta[6],0,100)}
theta = c(3,20,1,0.1,0.1,0.1)
sds = c(2.02,1.06,0.28,1.53,0.50,0.71)/2
model_2.4 = JGQD.mcmc(X,time,10,theta,sds,updates,burns,Jdist='Laplace')
mc = mcmc(model_3$par.matrix)
round( summary(window(mc,burns,updates,50))[[1]][,2],2)
JGQD.remove()
G0 = function(t){theta[1]*(theta[2]+theta[7]*sin(2*pi*t*4)+theta[8]*cos(2*pi*t*4))}
G1 = function(t){-theta[1]}
Q2 = function(t){theta[3]*theta[3]}
Lam0= function(t){theta[4]}
Jmu = function(t){theta[5]}
Jsig = function(t){theta[6]}
priors=function(theta){dunif(theta[3],0,100)*dunif(theta[4],0,100)*dunif(theta[6],0,100)}
theta = c(3,20,1,0.1,0.1,0.1,0.1,0.1)
sds = c(2.21,2.80,0.05,1.39,3.06,0.79,2.66,2.57)/2
model_2.5 = JGQD.mcmc(X,time,10,theta,sds,updates,burns)
JGQD.remove()
G0 = function(t){theta[1]*(theta[2]+theta[7]*sin(2*pi*t*4)+theta[8]*cos(2*pi*t*4))}
G1 = function(t){-theta[1]}
Q2 = function(t){theta[3]*theta[3]}
Lam0= function(t){theta[4]}
Ja = function(t){theta[5]}
Jb = function(t){theta[6]}
priors=function(theta){dunif(theta[3],0,100)*dunif(theta[4],0,100)*dunif(theta[6],0,100)}
theta = c(3,20,1,0.1,0.0,0.1,0.1,0.1)
sds = c(2.26,1.55,0.05,1.45,0.41,1.52,1.92,3.23)/1.5
model_2.6 = JGQD.mcmc(X,time,10,theta,sds,updates,burns,Jdist='Laplace')
mc = mcmc(model_2.3$par.matrix)
round( summary(window(mc,burns,updates,50))[[1]][,2],2)
JGQD.remove()
G0 = function(t){theta[1]*(theta[2]+theta[7]*sin(2*pi*t*4)+theta[8]*cos(2*pi*t*4))}
G1 = function(t){-theta[1]}
Q2 = function(t){theta[3]*theta[3]}
Lam1 = function(t){theta[4]}
Jmu = function(t){theta[5]}
Jsig = function(t){theta[6]}
priors = function(theta){dunif(theta[1],0,100)*dunif(theta[3],0,100)*dunif(theta[4],0,100)*dunif(theta[6],0,100)}
theta = c(3,20,1,0.05,0.1,0.1,0.1,0.1)
sds = c(2.18,1.98,0.05,0.16,1.20,0.26,2.02,1.95)/1.5
model_2.7 = JGQD.mcmc(X,time,10,theta,sds,updates,burns)
JGQD.remove()
G0 = function(t){theta[1]*(theta[2]+theta[7]*sin(2*pi*t*4)+theta[8]*cos(2*pi*t*4))}
G1 = function(t){-theta[1]}
Q2 = function(t){theta[3]*theta[3]}
Lam1 = function(t){theta[4]}
Ja = function(t){theta[5]}
Jb = function(t){theta[6]}
priors = function(theta){dunif(theta[1],0,100)*dunif(theta[3],0,100)*dunif(theta[4],0,100)*dunif(theta[6],0,100)}
theta = c(3,20,1,0.05,0.0,0.1,0.1,0.1)
sds = c(2.36,1.47,0.06,0.15,0.34,0.49,1.14,3.02)/1.5
model_2.8 = JGQD.mcmc(X,time,10,theta,sds,updates,burns,Jdist='Laplace')
#========================================================================================
# Quadratic models
#========================================================================================
JGQD.remove()
G1 = function(t){theta[1]*(theta[2]+theta[7]*sin(2*pi*t*4)+theta[8]*cos(2*pi*t*4))}
G2 = function(t){-theta[1]}
Q2 = function(t){theta[3]*theta[3]}
Lam0 = function(t){theta[4]}
Jmu = function(t){theta[5]}
Jsig = function(t){theta[6]}
priors=function(theta){dunif(theta[3],0,100)*dunif(theta[4],0,100)*dunif(theta[6],0,100)*dunif(theta[1],0,100)}
theta = c(0.5,20,1,0.05,0.1,0.1,0.1,0.1)
sds = c(0.07,1.25,0.04,2.65,0.82,1.07,1.56,3.31)/1.5
model_3.1 = JGQD.mcmc(X,time,10,theta,sds,updates,burns,print.output=FALSE)
JGQD.remove()
G1 = function(t){theta[1]*(theta[2]+theta[7]*sin(2*pi*t*4)+theta[8]*cos(2*pi*t*4))}
G2 = function(t){-theta[1]}
Q2 = function(t){theta[3]*theta[3]}
Lam0 = function(t){theta[4]}
Ja = function(t){theta[5]}
Jb = function(t){theta[6]}
priors=function(theta){dunif(theta[3],0,100)*dunif(theta[4],0,100)*dunif(theta[6],0,100)*dunif(theta[1],0,100)}
theta = c(0.1,30,0.1,0.1,0.1,0.1,0.1,0.1)
sds = c(0.08,1.41,0.05,1.69,0.38,1.33,2.05,4.96)/2
model_3.2 = JGQD.mcmc(X,time,10,theta,sds,updates,burns,print.output=FALSE,Jdist='Laplace')
JGQD.remove()
G1 = function(t){theta[1]*(theta[2]+theta[7]*sin(2*pi*t*4)+theta[8]*cos(2*pi*t*4))}
G2 = function(t){-theta[1]}
Q2 = function(t){theta[3]*theta[3]}
Lam1 = function(t){theta[4]}
Ja = function(t){theta[5]}
Jb = function(t){theta[6]}
priors=function(theta){dunif(theta[3],0,100)*dunif(theta[4],0,100)*dunif(theta[6],0,100)*dunif(theta[1],0,100)}
theta = c(0.1,20,0.1,0.1,0.0,0.1,0.1,0.1)
sds = c(0.08,1.34,0.06,0.2,0.40,1.24,1.56,3.31)/2
model_3.3 = JGQD.mcmc(X,time,10,theta,sds,updates,burns,print.output=FALSE,Jdist='Laplace')
JGQD.remove()
G1 = function(t){theta[1]*(theta[2]+theta[7]*sin(2*pi*t*4)+theta[8]*cos(2*pi*t*4))}
G2 = function(t){-theta[1]}
Q2 = function(t){theta[3]*theta[3]}
Lam1 = function(t){theta[4]}
Ja = function(t){theta[5]}
Jb = function(t){theta[6]}
priors=function(theta){dunif(theta[3],0,100)*dunif(theta[4],0,100)*dunif(theta[6],0,100)**dunif(theta[1],0,100)}
theta = c(0.1,20,0.1,0.1,0.0,0.1,0.1,0.1)
sds = c(0.08,1.34,0.06,0.25,0.40,1.24,1.56,3.31)/2
model_3.4 = JGQD.mcmc(X,time,10,theta,sds,updates,burns,print.output=FALSE,Jdist='Laplace')
#========================================================================================
# Statistics
#========================================================================================
# Build DIC and Estimate tables:
S =
list(model_1.1,model_1.2,model_1.3,model_1.4,model_1.5,model_1.6,
model_2.1,model_2.2,model_2.3,model_2.4,model_2.5,model_2.6,model_2.7,model_2.8,
model_3.1,model_3.2,model_3.3,model_3.4)
JGQD.dic(S)
browseVignettes('DiffusionRjgqd')