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 9695 among 10000.
R> head(fpt1d$fpt, n = 10)
[1] 0.119192 0.028378 0.104556 0.052134 0.067744 0.072457 0.154378
[8] 0.023051 0.108718 0.084770
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.19654
R> moment(fpt1d , center = TRUE , order = 2) ## variance
[1] 0.042353
R> Median(fpt1d)
[1] 0.11546
R> Mode(fpt1d)
[1] 0.048543
R> quantile(fpt1d)
0% 25% 50% 75% 100%
0.0047605 0.0536114 0.1154585 0.2606230 0.9989993
R> kurtosis(fpt1d)
[1] 5.4249
R> skewness(fpt1d)
[1] 1.7031
R> cv(fpt1d)
[1] 1.0472
R> min(fpt1d)
[1] 0.0047605
R> max(fpt1d)
[1] 0.999
R> moment(fpt1d , center= TRUE , order = 4)
[1] 0.0097331
R> moment(fpt1d , center= FALSE , order = 4)
[1] 0.032713
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.19654
Variance 0.04236
Median 0.11546
Mode 0.04854
First quartile 0.05361
Third quartile 0.26062
Minimum 0.00476
Maximum 0.99900
Skewness 1.70313
Kurtosis 5.42486
Coef-variation 1.04718
3th-order moment 0.01485
4th-order moment 0.00973
5th-order moment 0.00587
6th-order moment 0.00386
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] 5.8215 8.5382 6.2458 5.8734 6.1157 8.2251 6.5186 5.9028 6.4490
[10] 6.0186
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.51906
Variance 0.92493
Median 6.11566
Mode 5.99594
First quartile 5.94934
Third quartile 6.37970
Minimum 5.39927
Maximum 9.03196
Skewness 1.45339
Kurtosis 3.37850
Coef-variation 0.14753
3th-order moment 1.29285
4th-order moment 2.89032
5th-order moment 5.56807
6th-order moment 11.38602
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 9221 among 10000.
R> head(fpt2$fpt, n = 10)
[1] 1.3223 2.0316 2.0036 2.7731 1.3506 2.7379 1.4504 2.4857 3.5557
[10] 1.2806
R> summary(fpt2)
Monte-Carlo Statistics of F.P.T:
|T(S(t),X(t)) = inf{t >= 1 : X(t) >= 12 }
Mean 2.15880
Variance 0.48186
Median 2.05828
Mode 1.43236
First quartile 1.53377
Third quartile 2.62014
Minimum 1.09584
Maximum 3.99993
Skewness 0.64679
Kurtosis 2.51355
Coef-variation 0.32155
3th-order moment 0.21635
4th-order moment 0.58362
5th-order moment 0.59637
6th-order moment 1.08543
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.12305 0.50574
2 0.16452 0.50383
3 0.11201 0.50295
4 0.13758 0.50058
5 0.13298 0.49939
6 0.13041 0.50080
7 0.12211 0.50707
8 0.10499 0.50544
9 0.12414 0.49888
10 0.13225 0.50696
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.13399 0.50329
R> moment(fpt2d , center = TRUE , order = 2) ## variance
[1] 0.000177670 0.000027794
R> Median(fpt2d)
[1] 0.13333 0.50326
R> Mode(fpt2d)
[1] 0.13201 0.50330
R> quantile(fpt2d)
$x
0% 25% 50% 75% 100%
0.082878 0.125033 0.133330 0.142247 0.208726
$y
0% 25% 50% 75% 100%
0.47785 0.49980 0.50326 0.50671 0.52482
R> kurtosis(fpt2d)
[1] 3.6009 3.2286
R> skewness(fpt2d)
[1] 0.347162 0.054987
R> cv(fpt2d)
[1] 0.099483 0.010476
R> min(fpt2d)
[1] 0.082878 0.477848
R> max(fpt2d)
[1] 0.20873 0.52482
R> moment(fpt2d , center= TRUE , order = 4)
[1] 0.0000001136898 0.0000000024946
R> moment(fpt2d , center= FALSE , order = 4)
[1] 0.00034203 0.06420169
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.13399 0.50329
Variance 0.00018 0.00003
Median 0.13333 0.50326
Mode 0.13201 0.50330
First quartile 0.12503 0.49980
Third quartile 0.14225 0.50671
Minimum 0.08288 0.47785
Maximum 0.20873 0.52482
Skewness 0.34716 0.05499
Kurtosis 3.60085 3.22856
Coef-variation 0.09948 0.01048
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.55075 0.025697 0.75387
2 0.54559 0.022752 0.73932
3 0.54669 0.023601 0.74863
4 0.53520 0.023230 0.73852
5 0.52240 0.024248 0.76509
6 0.51776 0.021823 0.77156
7 0.54080 0.023043 0.76651
8 0.52869 0.023926 0.79584
9 0.54204 0.022775 0.79575
10 0.53858 0.026084 0.76423
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.531482 0.023263 0.783922
R> moment(fpt3d , center = TRUE , order = 2) ## variance
[1] 0.0001854317 0.0000016167 0.0009418028
R> Median(fpt3d)
[1] 0.530992 0.023215 0.784607
R> Mode(fpt3d)
[1] 0.528099 0.022903 0.782623
R> quantile(fpt3d)
$x
0% 25% 50% 75% 100%
0.48541 0.52239 0.53099 0.54036 0.58248
$y
0% 25% 50% 75% 100%
0.018957 0.022397 0.023215 0.024088 0.027976
$z
0% 25% 50% 75% 100%
0.66999 0.76342 0.78461 0.80481 0.88902
R> kurtosis(fpt3d)
[1] 3.0349 2.9978 3.0190
R> skewness(fpt3d)
[1] 0.15286 0.16131 -0.12775
R> cv(fpt3d)
[1] 0.025623 0.054660 0.039150
R> min(fpt3d)
[1] 0.485406 0.018957 0.669988
R> max(fpt3d)
[1] 0.582476 0.027976 0.889016
R> moment(fpt3d , center= TRUE , order = 4)
[1] 0.0000001043742417 0.0000000000078372 0.0000026784043796
R> moment(fpt3d , center= FALSE , order = 4)
[1] 0.08010616938 0.00000029816 0.38111540294
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.53148 0.02326 0.78392
Variance 0.00019 0.00000 0.00094
Median 0.53099 0.02322 0.78461
Mode 0.52810 0.02290 0.78262
First quartile 0.52239 0.02240 0.76342
Third quartile 0.54036 0.02409 0.80481
Minimum 0.48541 0.01896 0.66999
Maximum 0.58248 0.02798 0.88902
Skewness 0.15286 0.16131 -0.12775
Kurtosis 3.03486 2.99779 3.01904
Coef-variation 0.02562 0.05466 0.03915
3th-order moment 0.00000 0.00000 0.00000
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.0019136
x f(x)
Min. :0.47966 Min. : 0.0002
1st Qu.:0.50680 1st Qu.: 0.3878
Median :0.53394 Median : 4.1531
Mean :0.53394 Mean : 9.2032
3rd Qu.:0.56108 3rd Qu.:17.5519
Max. :0.58822 Max. :29.6963
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.00017994
y f(y)
Min. :0.018417 Min. : 0.004
1st Qu.:0.020942 1st Qu.: 4.463
Median :0.023466 Median : 47.155
Mean :0.023466 Mean : 98.930
3rd Qu.:0.025991 3rd Qu.:186.762
Max. :0.028516 Max. :312.701
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.0043777
z f(z)
Min. :0.018417 Min. : 0.004
1st Qu.:0.020942 1st Qu.: 4.463
Median :0.023466 Median : 47.155
Mean :0.023466 Mean : 98.930
3rd Qu.:0.025991 3rd Qu.:186.762
Max. :0.028516 Max. :312.701
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.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 (2017). Sim.DiffProc: Simulation of Diffusion Processes. R package version 4.0, 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)↩