fptsdekd()
functionsA new algorithm based on the Monte Carlo technique to generate the random variable FPT of a time homogeneous diffusion process (1, 2 and 3D) through a time-dependent boundary, order to estimate her probability density function.
Let \(X_t\) be a diffusion process which is the unique solution of the following stochastic differential equation:
\[\begin{equation}\label{eds01} dX_t = \mu(t,X_t) dt + \sigma(t,X_t) dW_t,\quad X_{t_{0}}=x_{0} \end{equation}\]if \(S(t)\) is a time-dependent boundary, we are interested in generating the first passage time (FPT) of the diffusion process through this boundary that is we will study the following random variable:
\[ \tau_{S(t)}= \left\{ \begin{array}{ll} inf \left\{t: X_{t} \geq S(t)|X_{t_{0}}=x_{0} \right\} & \hbox{if} \quad x_{0} \leq S(t_{0}) \\ inf \left\{t: X_{t} \leq S(t)|X_{t_{0}}=x_{0} \right\} & \hbox{if} \quad x_{0} \geq S(t_{0}) \end{array} \right. \]
The main arguments to ‘random’ fptsdekd()
(where k=1,2,3
) consist:
object
an object inheriting from class snssde1d
, snssde2d
and snssde3d
.boundary
an expression of a constant or time-dependent boundary \(S(t)\).The following statistical measures (S3 method
) for class fptsdekd()
can be approximated for F.P.T \(\tau_{S(t)}\):
mean
.moment
with order=2
and center=TRUE
.Median
.Mode
.quantile
.min
and max
.skewness
and kurtosis
.cv
.moment
.summary
.The main arguments to ‘density’ dfptsdekd()
(where k=1,2,3
) consist:
object
an object inheriting from class fptsdekd()
(where k=1,2,3
).pdf
probability density function Joint
or Marginal
.Consider the following SDE and linear boundary:
\[\begin{align*} dX_{t}= & (1-0.5 X_{t}) dt + dW_{t},~x_{0} =1.7.\\ S(t)= & 2(1-sinh(0.5t)) \end{align*}\]Generating the first passage time (FPT) of this model through this boundary: \[ \tau_{S(t)}= \inf \left\{t: X_{t} \geq S(t) |X_{t_{0}}=x_{0} \right\} ~~ \text{if} \quad x_{0} \leq S(t_{0}) \]
Set the model \(X_t\):
R> f <- expression( (1-0.5*x) )
R> g <- expression( 1 )
R> mod1d <- snssde1d(drift=f,diffusion=g,x0=1.7,M=10000,method="taylor")
Generate the first-passage-time \(\tau_{S(t)}\), with fptsde1d()
function ( based on density()
function in [base] package):
R> St <- expression(2*(1-sinh(0.5*t)) )
R> fpt1d <- fptsde1d(mod1d, boundary = St)
R> fpt1d
Itô Sde 1D:
| dX(t) = (1 - 0.5 * X(t)) * dt + 1 * dW(t)
| t in [0,1].
Boundary:
| S(t) = 2 * (1 - sinh(0.5 * t))
F.P.T:
| T(S(t),X(t)) = inf{t >= 0 : X(t) >= 2 * (1 - sinh(0.5 * t)) }
| Crossing realized 9732 among 10000.
R> head(fpt1d$fpt, n = 10)
[1] 0.408446 0.019148 0.250220 0.566931 0.055933 0.128651 0.185415
[8] 0.616436 0.147779 0.129864
The following statistical measures (S3 method
) for class fptsde1d()
can be approximated for the first-passage-time \(\tau_{S(t)}\):
R> mean(fpt1d)
[1] 0.19368
R> moment(fpt1d , center = TRUE , order = 2) ## variance
[1] 0.039669
R> Median(fpt1d)
[1] 0.1157
R> Mode(fpt1d)
[1] 0.048004
R> quantile(fpt1d)
0% 25% 50% 75% 100%
0.0058766 0.0553779 0.1156969 0.2599791 0.9989090
R> kurtosis(fpt1d)
[1] 5.713
R> skewness(fpt1d)
[1] 1.7386
R> cv(fpt1d)
[1] 1.0284
R> min(fpt1d)
[1] 0.0058766
R> max(fpt1d)
[1] 0.99891
R> moment(fpt1d , center= TRUE , order = 4)
[1] 0.008992
R> moment(fpt1d , center= FALSE , order = 4)
[1] 0.02997
The result summaries of the first-passage-time \(\tau_{S(t)}\):
R> summary(fpt1d)
Monte-Carlo Statistics of F.P.T:
|T(S(t),X(t)) = inf{t >= 0 : X(t) >= 2 * (1 - sinh(0.5 * t)) }
Mean 0.19368
Variance 0.03967
Median 0.11570
Mode 0.04800
First quartile 0.05538
Third quartile 0.25998
Minimum 0.00588
Maximum 0.99891
Skewness 1.73858
Kurtosis 5.71299
Coef-variation 1.02842
3th-order moment 0.01374
4th-order moment 0.00899
5th-order moment 0.00546
6th-order moment 0.00361
Display the exact first-passage-time \(\tau_{S(t)}\), see Figure 1:
R> plot(time(mod1d),mod1d$X[,1],type="l",lty=3,ylab="X(t)",xlab="time",axes=F)
R> curve(2*(1-sinh(0.5*x)),add=TRUE,col=2)
R> points(fpt1d$fpt[1],2*(1-sinh(0.5*fpt1d$fpt[1])),pch=19,col=4,cex=0.5)
R> lines(c(fpt1d$fpt[1],fpt1d$fpt[1]),c(0,2*(1-sinh(0.5*fpt1d$fpt[1]))),lty=2,col=4)
R> axis(1, fpt1d$fpt[1], bquote(tau[S(t)]==.(fpt1d$fpt[1])),col=4,col.ticks=4)
R> legend('topleft',col=c(1,2,4),lty=c(1,1,NA),pch=c(NA,NA,19),legend=c(expression(X[t]),expression(S(t)),expression(tau[S(t)])),cex=0.8,bty = 'n')
R> box()
The kernel density approximation of ‘fpt1d’, using dfptsde1d()
function (hist=TRUE
based on truehist()
function in MASS package), see e.g. Figure 2.
R> plot(dfptsde1d(fpt1d),hist=TRUE,nbins="FD") ## histogramm
R> plot(dfptsde1d(fpt1d)) ## kernel density
Since fptdApprox and DiffusionRgqd packages can very effectively handle first passage time problems for diffusions with analytically tractable transitional densities we use it to compare some of the results from the Sim.DiffProc package.
fptsde1d()
vs Approx.fpt.density()
Consider for example a diffusion process with SDE:
\[\begin{align*} dX_{t}= & 0.48 X_{t} dt + 0.07 X_{t} dW_{t},~x_{0} =1.\\ S(t)= & 7 + 3.2 t + 1.4 t \sin(1.75 t) \end{align*}\]The resulting object is then used by the Approx.fpt.density()
function in package fptdApprox to approximate the first passage time density:
R> require(fptdApprox)
R> x <- character(4)
R> x[1] <- "m * x"
R> x[2] <- "(sigma^2) * x^2"
R> x[3] <- "dnorm((log(x) - (log(y) + (m - sigma^2/2) * (t- s)))/(sigma * sqrt(t - s)),0,1)/(sigma * sqrt(t - s) * x)"
R> x[4] <- "plnorm(x,log(y) + (m - sigma^2/2) * (t - s),sigma * sqrt(t - s))"
R> Lognormal <- diffproc(x)
R> res1 <- Approx.fpt.density(Lognormal, 0, 10, 1, "7 + 3.2 * t + 1.4 * t * sin(1.75 * t)",list(m = 0.48,sigma = 0.07))
Using fptsde1d()
and dfptsde1d()
functions in the Sim.DiffProc package:
R> ## Set the model X(t)
R> f <- expression( 0.48*x )
R> g <- expression( 0.07*x )
R> mod1 <- snssde1d(drift=f,diffusion=g,x0=1,T=10,M=10000)
R> ## Set the boundary S(t)
R> St <- expression( 7 + 3.2 * t + 1.4 * t * sin(1.75 * t) )
R> ## Generate the fpt
R> fpt1 <- fptsde1d(mod1, boundary = St)
R> fpt1
Itô Sde 1D:
| dX(t) = 0.48 * X(t) * dt + 0.07 * X(t) * dW(t)
| t in [0,10].
Boundary:
| S(t) = 7 + 3.2 * t + 1.4 * t * sin(1.75 * t)
F.P.T:
| T(S(t),X(t)) = inf{t >= 0 : X(t) >= 7 + 3.2 * t + 1.4 * t * sin(1.75 * t) }
| Crossing realized 10000 among 10000.
R> head(fpt1$fpt, n = 10)
[1] 6.0430 5.7674 6.1224 6.0167 6.2545 6.0413 6.3060 8.5292 5.8412
[10] 5.9995
R> summary(fpt1)
Monte-Carlo Statistics of F.P.T:
|T(S(t),X(t)) = inf{t >= 0 : X(t) >= 7 + 3.2 * t + 1.4 * t * sin(1.75 * t) }
Mean 6.50657
Variance 0.89692
Median 6.10833
Mode 6.01679
First quartile 5.95031
Third quartile 6.38087
Minimum 5.33409
Maximum 9.05071
Skewness 1.48878
Kurtosis 3.49496
Coef-variation 0.14555
3th-order moment 1.26463
4th-order moment 2.81159
5th-order moment 5.43271
6th-order moment 11.10259
By plotting the approximations:
R> plot(res1$y ~ res1$x, type = 'l',main = 'Approximation First-Passage-Time Density', ylab = 'Density', xlab = expression(tau[S(t)]),cex.main = 0.95,lwd=2)
R> plot(dfptsde1d(fpt1,bw="bcv"),add=TRUE)
R> legend('topright', lty = c(1, NA), col = c(1,'#BBCCEE'),pch=c(NA,15),legend = c('Approx.fpt.density()', 'fptsde1d()'), lwd = 2, bty = 'n')
fptsde1d()
vs Approx.fpt.density()
fptsde1d()
vs GQD.TIpassage()
Consider for example a diffusion process with SDE:
\[\begin{align*} dX_{t}= & \theta_{1}X_{t}(10+0.2\sin(2\pi t)+0.3\sqrt(t)(1+\cos(3\pi t))-X_{t}) ) dt + \sqrt(0.1) X_{t} dW_{t},~x_{0} =8.\\ S(t)= & 12 \end{align*}\]The resulting object is then used by the GQD.TIpassage()
function in package DiffusionRgqd to approximate the first passage time density:
R> require(DiffusionRgqd)
R> G1 <- function(t)
+ {
+ theta[1] * (10+0.2 * sin(2 * pi * t) + 0.3 * prod(sqrt(t),
+ 1+cos(3 * pi * t)))
+ }
R> G2 <- function(t){-theta[1]}
R> Q2 <- function(t){0.1}
R> res2 = GQD.TIpassage(8, 12, 1, 4, 1 / 100, theta = c(0.5))
Using fptsde1d()
and dfptsde1d()
functions in the Sim.DiffProc package:
R> ## Set the model X(t)
R> theta1=0.5
R> f <- expression( theta1*x*(10+0.2*sin(2*pi*t)+0.3*sqrt(t)*(1+cos(3*pi*t))-x) )
R> g <- expression( sqrt(0.1)*x )
R> mod2 <- snssde1d(drift=f,diffusion=g,x0=8,t0=1,T=4,M=10000)
R> ## Set the boundary S(t)
R> St <- expression( 12 )
R> ## Generate the fpt
R> fpt2 <- fptsde1d(mod2, boundary = St)
R> fpt2
Itô Sde 1D:
| dX(t) = theta1 * X(t) * (10 + 0.2 * sin(2 * pi * t) + 0.3 * sqrt(t) * (1 + cos(3 * pi * t)) - X(t)) * dt + sqrt(0.1) * X(t) * dW(t)
| t in [1,4].
Boundary:
| S(t) = 12
F.P.T:
| T(S(t),X(t)) = inf{t >= 1 : X(t) >= 12 }
| Crossing realized 9217 among 10000.
R> head(fpt2$fpt, n = 10)
[1] 1.5276 3.4074 1.3442 3.3429 2.6770 1.7759 2.9078 2.8731 1.7458
[10] 1.5101
R> summary(fpt2)
Monte-Carlo Statistics of F.P.T:
|T(S(t),X(t)) = inf{t >= 1 : X(t) >= 12 }
Mean 2.16537
Variance 0.49916
Median 2.05753
Mode 1.43094
First quartile 1.52964
Third quartile 2.63391
Minimum 1.10674
Maximum 3.99972
Skewness 0.66389
Kurtosis 2.51061
Coef-variation 0.32628
3th-order moment 0.23413
4th-order moment 0.62555
5th-order moment 0.65236
6th-order moment 1.18894
By plotting the approximations (hist=TRUE
based on truehist()
function in MASS package):
R> plot(dfptsde1d(fpt2),hist=TRUE,nbins = "Scott",main = 'Approximation First-Passage-Time Density', ylab = 'Density', xlab = expression(tau[S(t)]), cex.main = 0.95)
R> lines(res2$density ~ res2$time, type = 'l',lwd=2)
R> legend('topright', lty = c(1, NA), col = c(1,'#FF00004B'),pch=c(NA,15),legend = c('GQD.TIpassage()', 'fptsde1d()'), lwd = 2, bty = 'n')
fptsde1d()
vs GQD.TIpassage()
The following \(2\)-dimensional SDE’s with a vector of drift and a diagonal matrix of diffusion coefficients:
\[\begin{equation}\label{eq:09} \begin{cases} dX_t = f_{x}(t,X_{t},Y_{t}) dt + g_{x}(t,X_{t},Y_{t}) dW_{1,t}\\ dY_t = f_{y}(t,X_{t},Y_{t}) dt + g_{y}(t,X_{t},Y_{t}) dW_{2,t} \end{cases} \end{equation}\]\(W_{1,t}\) and \(W_{2,t}\) is a two independent standard Wiener process. First passage time (2D) \((\tau_{(S(t),X_{t})},\tau_{(S(t),Y_{t})})\) is defined as:
\[ \left\{ \begin{array}{ll} \tau_{S(t),X_{t}}=\inf \left\{t: X_{t} \geq S(t)|X_{t_{0}}=x_{0} \right\} & \hbox{if} \quad x_{0} \leq S(t_{0}) \\ \tau_{S(t),Y_{t}}=\inf \left\{t: Y_{t} \geq S(t)|Y_{t_{0}}=y_{0} \right\} & \hbox{if} \quad y_{0} \leq S(t_{0}) \end{array} \right. \] and \[ \left\{ \begin{array}{ll} \tau_{S(t),X_{t}}= \inf \left\{t: X_{t} \leq S(t)|X_{t_{0}}=x_{0} \right\} & \hbox{if} \quad x_{0} \geq S(t_{0}) \\ \tau_{S(t),Y_{t}}= \inf \left\{t: Y_{t} \leq S(t)|Y_{t_{0}}=y_{0} \right\} & \hbox{if} \quad y_{0} \geq S(t_{0}) \end{array} \right. \]
Assume that we want to describe the following Stratonovich SDE’s (2D):
\[\begin{equation}\label{eq016} \begin{cases} dX_t = 5 (-1-Y_{t}) X_{t} dt + 0.5 Y_{t} \circ dW_{1,t}\\ dY_t = 5 (-1-X_{t}) Y_{t} dt + 0.5 X_{t} \circ dW_{2,t} \end{cases} \end{equation}\]and \[ S(t)=\sin(2\pi t) \]
Set the system \((X_t , Y_t)\):
R> fx <- expression(5*(-1-y)*x , 5*(-1-x)*y)
R> gx <- expression(0.5*y,0.5*x)
R> mod2d <- snssde2d(drift=fx,diffusion=gx,x0=c(x=1,y=-1),M=10000,type="str")
Generate the couple \((\tau_{(S(t),X_{t})},\tau_{(S(t),Y_{t})})\), with fptsde2d()
function::
R> St <- expression(sin(2*pi*t))
R> fpt2d <- fptsde2d(mod2d, boundary = St)
R> fpt2d
Stratonovich Sde 2D:
| dX(t) = 5 * (-1 - Y(t)) * X(t) * dt + 0.5 * Y(t) o dW1(t)
| dY(t) = 5 * (-1 - X(t)) * Y(t) * dt + 0.5 * X(t) o dW2(t)
| t in [0,1].
Boundary:
| S(t) = sin(2 * pi * t)
F.P.T:
| T(S(t),X(t)) = inf{t >= 0 : X(t) <= sin(2 * pi * t) }
| And
| T(S(t),Y(t)) = inf{t >= 0 : Y(t) >= sin(2 * pi * t) }
| Crossing realized 10000 among 10000.
R> head(fpt2d$fpt, n = 10)
x y
1 0.13143 0.50174
2 0.15869 0.49871
3 0.10481 0.49758
4 0.12433 0.50313
5 0.12777 0.50995
6 0.12823 0.51313
7 0.11340 0.51057
8 0.11914 0.49837
9 0.14969 0.50056
10 0.13636 0.50997
The following statistical measures (S3 method
) for class fptsde2d()
can be approximated for the couple \((\tau_{(S(t),X_{t})},\tau_{(S(t),Y_{t})})\):
R> mean(fpt2d)
[1] 0.13364 0.50337
R> moment(fpt2d , center = TRUE , order = 2) ## variance
[1] 0.000172280 0.000027242
R> Median(fpt2d)
[1] 0.13307 0.50331
R> Mode(fpt2d)
[1] 0.13214 0.50325
R> quantile(fpt2d)
$x
0% 25% 50% 75% 100%
0.089802 0.124830 0.133065 0.141733 0.199756
$y
0% 25% 50% 75% 100%
0.48380 0.49985 0.50331 0.50681 0.52347
R> kurtosis(fpt2d)
[1] 3.5417 3.1567
R> skewness(fpt2d)
[1] 0.31236 0.05902
R> cv(fpt2d)
[1] 0.098218 0.010369
R> min(fpt2d)
[1] 0.089802 0.483805
R> max(fpt2d)
[1] 0.19976 0.52347
R> moment(fpt2d , center= TRUE , order = 4)
[1] 0.0000001051398 0.0000000023432
R> moment(fpt2d , center= FALSE , order = 4)
[1] 0.00033795 0.06424395
The result summaries of the couple \((\tau_{(S(t),X_{t})},\tau_{(S(t),Y_{t})})\):
R> summary(fpt2d)
Monte-Carlo Statistics for the F.P.T of (X(t),Y(t))
| T(S(t),X(t)) = inf{t >= 0 : X(t) <= sin(2 * pi * t) }
| And
| T(S(t),Y(t)) = inf{t >= 0 : Y(t) >= sin(2 * pi * t) }
T(S,X) T(S,Y)
Mean 0.13364 0.50337
Variance 0.00017 0.00003
Median 0.13307 0.50331
Mode 0.13214 0.50325
First quartile 0.12483 0.49985
Third quartile 0.14173 0.50681
Minimum 0.08980 0.48380
Maximum 0.19976 0.52347
Skewness 0.31236 0.05902
Kurtosis 3.54169 3.15675
Coef-variation 0.09822 0.01037
3th-order moment 0.00000 0.00000
4th-order moment 0.00000 0.00000
5th-order moment 0.00000 0.00000
6th-order moment 0.00000 0.00000
Display the exact first-passage-time \(\tau_{S(t)}\), see Figure 5:
R> plot(ts.union(mod2d$X[,1],mod2d$Y[,1]),col=1:2,lty=3,plot.type="single",type="l",ylab= "",xlab="time",axes=F)
R> curve(sin(2*pi*x),add=TRUE,col=3)
R> points(fpt2d$fpt$x[1],sin(2*pi*fpt2d$fpt$x[1]),pch=19,col=4,cex=0.5)
R> lines(c(fpt2d$fpt$x[1],fpt2d$fpt$x[1]),c(sin(2*pi*fpt2d$fpt$x[1]),-10),lty=2,col=4)
R> axis(1, fpt2d$fpt$x[1], bquote(tau[X[S(t)]]==.(fpt2d$fpt$x[1])),col=4,col.ticks=4)
R> points(fpt2d$fpt$y[1],sin(2*pi*fpt2d$fpt$y[1]),pch=19,col=5,cex=0.5)
R> lines(c(fpt2d$fpt$y[1],fpt2d$fpt$y[1]),c(sin(2*pi*fpt2d$fpt$y[1]),-10),lty=2,col=5)
R> axis(1, fpt2d$fpt$y[1], bquote(tau[Y[S(t)]]==.(fpt2d$fpt$y[1])),col=5,col.ticks=5)
R> legend('topright',col=1:5,lty=c(1,1,1,NA,NA),pch=c(NA,NA,NA,19,19),legend=c(expression(X[t]),expression(Y[t]),expression(S(t)),expression(tau[X[S(t)]]),expression(tau[Y[S(t)]])),cex=0.8,inset = .01)
R> box()
The marginal density of \((\tau_{(S(t),X_{t})}\) and \(\tau_{(S(t),Y_{t})})\) are reported using dfptsde2d()
function, see e.g. Figure 6.
R> denM <- dfptsde2d(fpt2d, pdf = 'M')
R> plot(denM)
A contour
and image
plot of density obtained from a realization of system \((\tau_{(S(t),X_{t})},\tau_{(S(t),Y_{t})})\).
R> denJ <- dfptsde2d(fpt2d, pdf = 'J',n=100)
R> plot(denJ,display="contour",main="Bivariate Density of F.P.T",xlab=expression(tau[x]),ylab=expression(tau[y]))
R> plot(denJ,display="image",main="Bivariate Density of F.P.T",xlab=expression(tau[x]),ylab=expression(tau[y]))
A \(3\)D plot of the Joint density with:
R> plot(denJ,display="persp",main="Bivariate Density of F.P.T",xlab=expression(tau[x]),ylab=expression(tau[y]))
The following \(3\)-dimensional SDE’s with a vector of drift and a diagonal matrix of diffusion coefficients:
\[\begin{equation}\label{eq17} \begin{cases} dX_t = f_{x}(t,X_{t},Y_{t},Z_{t}) dt + g_{x}(t,X_{t},Y_{t},Z_{t}) dW_{1,t}\\ dY_t = f_{y}(t,X_{t},Y_{t},Z_{t}) dt + g_{y}(t,X_{t},Y_{t},Z_{t}) dW_{2,t}\\ dZ_t = f_{z}(t,X_{t},Y_{t},Z_{t}) dt + g_{z}(t,X_{t},Y_{t},Z_{t}) dW_{3,t} \end{cases} \end{equation}\]\(W_{1,t}\), \(W_{2,t}\) and \(W_{3,t}\) is a 3 independent standard Wiener process. First passage time (3D) \((\tau_{(S(t),X_{t})},\tau_{(S(t),Y_{t})},\tau_{(S(t),Z_{t})})\) is defined as:
\[ \left\{ \begin{array}{ll} \tau_{S(t),X_{t}}=\inf \left\{t: X_{t} \geq S(t)|X_{t_{0}}=x_{0} \right\} & \hbox{if} \quad x_{0} \leq S(t_{0}) \\ \tau_{S(t),Y_{t}}=\inf \left\{t: Y_{t} \geq S(t)|Y_{t_{0}}=y_{0} \right\} & \hbox{if} \quad y_{0} \leq S(t_{0}) \\ \tau_{S(t),Z_{t}}=\inf \left\{t: Z_{t} \geq S(t)|Z_{t_{0}}=z_{0} \right\} & \hbox{if} \quad z_{0} \leq S(t_{0}) \end{array} \right. \] and \[ \left\{ \begin{array}{ll} \tau_{S(t),X_{t}}= \inf \left\{t: X_{t} \leq S(t)|X_{t_{0}}=x_{0} \right\} & \hbox{if} \quad x_{0} \geq S(t_{0}) \\ \tau_{S(t),Y_{t}}= \inf \left\{t: Y_{t} \leq S(t)|Y_{t_{0}}=y_{0} \right\} & \hbox{if} \quad y_{0} \geq S(t_{0}) \\ \tau_{S(t),Z_{t}}= \inf \left\{t: Z_{t} \leq S(t)|Z_{t_{0}}=z_{0} \right\} & \hbox{if} \quad z_{0} \geq S(t_{0}) \\ \end{array} \right. \]
Assume that we want to describe the following SDE’s (3D): \[\begin{equation}\label{eq0166} \begin{cases} dX_t = 4 (-1-X_{t}) Y_{t} dt + 0.2 dW_{1,t}\\ dY_t = 4 (1-Y_{t}) X_{t} dt + 0.2 dW_{2,t}\\ dZ_t = 4 (1-Z_{t}) Y_{t} dt + 0.2 dW_{3,t} \end{cases} \end{equation}\]and \[ S(t)=-1.5+3t \]
Set the system \((X_t , Y_t , Z_t)\):
R> fx <- expression(4*(-1-x)*y , 4*(1-y)*x , 4*(1-z)*y)
R> gx <- rep(expression(0.2),3)
R> mod3d <- snssde3d(drift=fx,diffusion=gx,x0=c(x=2,y=-2,z=0),M=10000)
Generate the triplet \((\tau_{(S(t),X_{t})},\tau_{(S(t),Y_{t})},\tau_{(S(t),Z_{t})})\), with fptsde3d()
function::
R> St <- expression(-1.5+3*t)
R> fpt3d <- fptsde3d(mod3d, boundary = St)
R> fpt3d
Itô Sde 3D:
| dX(t) = 4 * (-1 - X(t)) * Y(t) * dt + 0.2 * dW1(t)
| dY(t) = 4 * (1 - Y(t)) * X(t) * dt + 0.2 * dW2(t)
| dZ(t) = 4 * (1 - Z(t)) * Y(t) * dt + 0.2 * dW3(t)
| t in [0,1].
Boundary:
| S(t) = -1.5 + 3 * t
F.P.T:
| T(S(t),X(t)) = inf{t >= 0 : X(t) <= -1.5 + 3 * t }
| And
| T(S(t),Y(t)) = inf{t >= 0 : Y(t) >= -1.5 + 3 * t }
| And
| T(S(t),Z(t)) = inf{t >= 0 : Z(t) <= -1.5 + 3 * t }
| Crossing realized 10000 among 10000.
R> head(fpt3d$fpt, n = 10)
x y z
1 0.52511 0.020723 0.80595
2 0.51706 0.023828 0.83835
3 0.52075 0.023654 0.80454
4 0.51578 0.020377 0.80439
5 0.54089 0.023019 0.77087
6 0.53609 0.024622 0.80630
7 0.52330 0.023765 0.77769
8 0.50704 0.023146 0.83501
9 0.52057 0.022344 0.71160
10 0.52248 0.022310 0.76762
The following statistical measures (S3 method
) for class fptsde3d()
can be approximated for the triplet \((\tau_{(S(t),X_{t})},\tau_{(S(t),Y_{t})},\tau_{(S(t),Z_{t})})\):
R> mean(fpt3d)
[1] 0.532058 0.023232 0.783332
R> moment(fpt3d , center = TRUE , order = 2) ## variance
[1] 0.0001886890 0.0000016126 0.0009494446
R> Median(fpt3d)
[1] 0.53182 0.02321 0.78433
R> Mode(fpt3d)
[1] 0.532023 0.023048 0.784090
R> quantile(fpt3d)
$x
0% 25% 50% 75% 100%
0.48151 0.52273 0.53182 0.54101 0.58641
$y
0% 25% 50% 75% 100%
0.018951 0.022369 0.023210 0.024062 0.029659
$z
0% 25% 50% 75% 100%
0.64996 0.76351 0.78433 0.80442 0.89834
R> kurtosis(fpt3d)
[1] 3.0717 3.0306 3.1348
R> skewness(fpt3d)
[1] 0.12851 0.11167 -0.20504
R> cv(fpt3d)
[1] 0.025819 0.054664 0.039338
R> min(fpt3d)
[1] 0.481511 0.018951 0.649960
R> max(fpt3d)
[1] 0.586413 0.029659 0.898342
R> moment(fpt3d , center= TRUE , order = 4)
[1] 0.0000001093867573 0.0000000000078822 0.0000028263941330
R> moment(fpt3d , center= FALSE , order = 4)
[1] 0.08045886514 0.00000029654 0.37999631192
The result summaries of the triplet \((\tau_{(S(t),X_{t})},\tau_{(S(t),Y_{t})},\tau_{(S(t),Z_{t})})\):
R> summary(fpt3d)
Monte-Carlo Statistics for the F.P.T of (X(t),Y(t),Z(t))
| T(S(t),X(t)) = inf{t >= 0 : X(t) <= -1.5 + 3 * t }
| And
| T(S(t),Y(t)) = inf{t >= 0 : Y(t) >= -1.5 + 3 * t }
| And
| T(S(t),Z(t)) = inf{t >= 0 : Z(t) <= -1.5 + 3 * t }
T(S,X) T(S,Y) T(S,Z)
Mean 0.53206 0.02323 0.78333
Variance 0.00019 0.00000 0.00095
Median 0.53182 0.02321 0.78433
Mode 0.53202 0.02305 0.78409
First quartile 0.52273 0.02237 0.76351
Third quartile 0.54101 0.02406 0.80442
Minimum 0.48151 0.01895 0.64996
Maximum 0.58641 0.02966 0.89834
Skewness 0.12851 0.11167 -0.20504
Kurtosis 3.07174 3.03057 3.13478
Coef-variation 0.02582 0.05466 0.03934
3th-order moment 0.00000 0.00000 -0.00001
4th-order moment 0.00000 0.00000 0.00000
5th-order moment 0.00000 0.00000 0.00000
6th-order moment 0.00000 0.00000 0.00000
Display the exact first-passage-time \(\tau_{S(t)}\), see Figure 9:
R> plot(ts.union(mod3d$X[,1],mod3d$Y[,1],mod3d$Z[,1]),col=1:3,lty=3,plot.type="single",type="l",ylab="",xlab="time",axes=F)
R> curve(-1.5+3*x,add=TRUE,col=4)
R> points(fpt3d$fpt$x[1],-1.5+3*fpt3d$fpt$x[1],pch=19,col=5,cex=0.5)
R> lines(c(fpt3d$fpt$x[1],fpt3d$fpt$x[1]),c(-1.5+3*fpt3d$fpt$x[1],-10),lty=2,col=5)
R> axis(1, fpt3d$fpt$x[1], bquote(tau[X[S(t)]]==.(fpt3d$fpt$x[1])),col=5,col.ticks=5)
R> points(fpt3d$fpt$y[1],-1.5+3*fpt3d$fpt$y[1],pch=19,col=6,cex=0.5)
R> lines(c(fpt3d$fpt$y[1],fpt3d$fpt$y[1]),c(-1.5+3*fpt3d$fpt$y[1],-10),lty=2,col=6)
R> axis(1, fpt3d$fpt$y[1], bquote(tau[Y[S(t)]]==.(fpt3d$fpt$y[1])),col=6,col.ticks=6)
R> points(fpt3d$fpt$z[1],-1.5+3*fpt3d$fpt$z[1],pch=19,col=7,cex=0.5)
R> lines(c(fpt3d$fpt$z[1],fpt3d$fpt$z[1]),c(-1.5+3*fpt3d$fpt$z[1],-10),lty=2,col=7)
R> axis(1, fpt3d$fpt$z[1], bquote(tau[Z[S(t)]]==.(fpt3d$fpt$z[1])),col=7,col.ticks=7)
R> legend('topright',col=1:7,lty=c(1,1,1,1,NA,NA,NA),pch=c(NA,NA,NA,NA,19,19,19),legend=c(expression(X[t]),expression(Y[t]),expression(Z[t]),expression(S(t)),expression(tau[X[S(t)]]),expression(tau[Y[S(t)]]),expression(tau[Z[S(t)]])),cex=0.8,inset = .01)
R> box()
The marginal density of \(\tau_{(S(t),X_{t})}\) ,\(\tau_{(S(t),Y_{t})}\) and \(\tau_{(S(t),Z_{t})})\) are reported using dfptsde3d()
function, see e.g. Figure 10.
R> denM <- dfptsde3d(fpt3d, pdf = "M")
R> denM
Marginal density for the F.P.T of X(t)
| T(S,X) = inf{t >= 0 : X(t) <= -1.5 + 3 * t}
Data: out[, "x"] (10000 obs.); Bandwidth 'bw' = 0.0019461
x f(x)
Min. :0.47567 Min. : 0.0002
1st Qu.:0.50482 1st Qu.: 0.2747
Median :0.53396 Median : 3.1945
Mean :0.53396 Mean : 8.5695
3rd Qu.:0.56311 3rd Qu.:16.3523
Max. :0.59225 Max. :28.9523
Marginal density for the F.P.T of Y(t)
| T(S,Y) = inf{t >= 0 : Y(t) >= -1.5 + 3 * t}
Data: out[, "y"] (10000 obs.); Bandwidth 'bw' = 0.00018026
y f(y)
Min. :0.018410 Min. : 0.00
1st Qu.:0.021358 1st Qu.: 0.63
Median :0.024305 Median : 24.01
Mean :0.024305 Mean : 84.73
3rd Qu.:0.027253 3rd Qu.:159.37
Max. :0.030200 Max. :317.61
Marginal density for the F.P.T of Z(t)
| T(S,Z) = inf{t >= 0 : Z(t) <= -1.5 + 3 * t}
Data: out[, "z"] (10000 obs.); Bandwidth 'bw' = 0.0043553
z f(z)
Min. :0.018410 Min. : 0.00
1st Qu.:0.021358 1st Qu.: 0.63
Median :0.024305 Median : 24.01
Mean :0.024305 Mean : 84.73
3rd Qu.:0.027253 3rd Qu.:159.37
Max. :0.030200 Max. :317.61
R> plot(denM)
For an approximate joint density for \((\tau_{(S(t),X_{t})},\tau_{(S(t),Y_{t})},\tau_{(S(t),Z_{t})})\) (for more details, see package sm or ks.)
R> denJ <- dfptsde3d(fpt3d,pdf="J")
R> plot(denJ,display="rgl")
snssdekd()
& dsdekd()
& rsdekd()
- Monte-Carlo Simulation and Analysis of Stochastic Differential Equations.bridgesdekd()
& dsdekd()
& rsdekd()
- Constructs and Analysis of Bridges Stochastic Differential Equations.fptsdekd()
& dfptsdekd()
- Monte-Carlo Simulation and Kernel Density Estimation of First passage time.MCM.sde()
& MEM.sde()
- Parallel Monte-Carlo and Moment Equations for SDEs.TEX.sde()
- Converting Sim.DiffProc Objects to LaTeX.fitsde()
- Parametric Estimation of 1-D Stochastic Differential Equation.Boukhetala K (1996). Modelling and Simulation of a Dispersion Pollutant with Attractive Centre, volume 3, pp. 245-252. Computer Methods and Water Resources, Computational Mechanics Publications, Boston, USA.
Boukhetala K (1998). Estimation of the first passage time distribution for a simulated diffusion process. Maghreb Mathematical Review, 7, pp. 1-25.
Boukhetala K (1998). Kernel density of the exit time in a simulated diffusion. The Annals of The Engineer Maghrebian, 12, pp. 587-589.
Guidoum AC, Boukhetala K (2018). Sim.DiffProc: Simulation of Diffusion Processes. R package version 4.1, URL https://cran.r-project.org/package=Sim.DiffProc.
Pienaar EAD, Varughese MM (2016). DiffusionRgqd: An R Package for Performing Inference and Analysis on Time-Inhomogeneous Quadratic Diffusion Processes. R package version 0.1.3, URL https://CRAN.R-project.org/package=DiffusionRgqd.
Roman, R.P., Serrano, J. J., Torres, F. (2008). First-passage-time location function: Application to determine first-passage-time densities in diffusion processes. Computational Statistics and Data Analysis. 52, 4132-4146.
Roman, R.P., Serrano, J. J., Torres, F. (2012). An R package for an efficient approximation of first-passage-time densities for diffusion processes based on the FPTL function. Applied Mathematics and Computation, 218, 8408-8428.
Department of Probabilities & Statistics, Faculty of Mathematics, University of Science and Technology Houari Boumediene, BP 32 El-Alia, U.S.T.H.B, Algeria, E-mail (acguidoum@usthb.dz)↩
Faculty of Mathematics, University of Science and Technology Houari Boumediene, BP 32 El-Alia, U.S.T.H.B, Algeria, E-mail (kboukhetala@usthb.dz)↩