# R/InlineOptionsschein.R In fCertificates: fCertificates - Basics of Certificates and Structured Products Valuation

```# Bewertung von Inline-Optionsscheinen / Range of the Geometric Brownian Motion / Double-Barrier Binary Option
#
# Range a < x < b
#
# P(a < m <= M < b, x) --> fixer Payoff
#
# Literatur:
#
# (1) Sutrick, Teall, Tucker, Wei (1997): The Range of Brownian Motion Processes, The Journal of Financial Engineering, Vol.6, 31-46
# (2) Hui (1996) : One-Touch Barrier Binary Option Values, Applied Financial Economics Vol. 6, 343-346
# (3) Haug (2007), p. 180/181

#source("C:/Projects/Java/certificateserver/docs/modelle/GBB.R")
#source("F:/Promotion/Sweave/Expressstudie/GBB.R")

# Simuliere N Geometrische Brownsche Bewegungen
#S0    = 100
#mu    = 0
#sigma = 0.3
#T     = 1
#
#simProbInRange <- function(S0, a, b, mu, sigma, T, mc.loops, mc.steps)
#{
#  S     = matrix(NA, mc.loops, mc.steps+1)
#  for (i in 1:mc.loops)
#  {
#    S[i,] = GBB(S0=S0, mu, sigma, T, N=mc.steps)
#  }#
#
#  # Minimum m_t
#  m_t = apply(S, 1, min)
#  M_t = apply(S, 1, max)

#  # Wahrscheinlichkeit aus Monte Carlo, zwischen a und b zu bleiben
#  p = mean(m_t >= a & M_t <= b)
#  p
#}

# Arithmetische Brownsche Bewegung ohne Drift: Wahrscheinlichkeit, in der Range [a,b] zu bleiben
#
# P(a < m <= M < b, x)
#
probInRange <- function(x, a, b, T, sigma)
{
# k = -Inf ... +Inf
p = 0
for (k in -100:100)
{
p = p + (pnorm((b + 2 * k * (b - a)) / (sigma*sqrt(T)))        - pnorm((a + 2 * k * (b - a)) / (sigma*sqrt(T)))) -
(pnorm((2*b - a + 2 * k * (b - a)) / (sigma*sqrt(T)))  - pnorm((2 * b - b + 2 * k * (b - a)) / (sigma*sqrt(T))))
}
return (p)
}

# Wahrscheinlichkeit ausrechnen, zwischen 80 und 120 zu bleiben
#probInRange(a=log(70)-log(S0), b=log(120)-log(S0), T=1, sigma=0.3)
#
#probInRange(a=log(4800)-log(5473), b=log(5600)-log(5473), T=7/365, sigma=0.3)
#
#simProbInRange(S0=5473, a=4800, b=5600, mu=0.01, sigma=0.28, T=7/365, mc.loops=1000, mc.steps=1000)

# Formel von Hui (1996)
#
# @param S
# @param L lower barrier
# @param U upper barrier
# @param K fix payoff
DoubleBarrierBinaryCall <- function(S, K, L, U, T, r, r_d, sigma, ratio=1, nmax=20)
{
# i = 1 ... +Inf
c = 0

# cost-of-carry
b     = r - r_d
Z     = log(U/L)
alpha = -0.5  * (2*b/sigma^2 - 1)
beta  = -0.25 * (2*b/sigma^2 - 1) - 2*r/sigma^2

for (i in 1:nmax)
{
c = c + 2*pi*i*K/Z^2 * ((S/L)^alpha - (-1)^i * (S/U)^alpha) / (alpha^2 + (i*pi/Z)^2) * sin(i*pi/Z*log(S/L)) * exp(-0.5*((i*pi/Z)^2 - beta)*sigma^2*T)
}
return(c*ratio)
}

# Beispiel: CM2KC7
DoubleBarrierBinaryCall(S=5473, K=10, L=4800, U=5600, T=6/365, r=0.01, r_d=0, sigma=0.28)
```

## Try the fCertificates package in your browser

Any scripts or data that you put into this service are public.

fCertificates documentation built on May 2, 2019, 5:50 p.m.