Attribute VB_Name = "Module1"

Public Function bscall(s, k, r, sg, t)
d1 = (Log(s / k) + (r + sg ^ 2) * t) / Sqr(t) / sg
d2 = d1 - sg * Sqr(t)
nd1 = Application.WorksheetFunction.NormSDist(d1)
nd2 = Application.WorksheetFunction.NormSDist(d2)
bscall = s * nd1 - k * Exp(-r * t) * nd2
End Function

Public Function bisection(c, s, k, r, sg0, t)
ce = bscall(s, k, r, sg0, t)
sg = sg0
If ce < c Then
sg = sg0 + 2
ce = bscall(s, k, r, sg, t)
sg0 = sg
End If
Do While Abs(c - ce) > 0.001
i = i + 1
If ce > c Then
sg = sg - sg0 / 2 ^ i
Else
sg = sg + sg0 / 2 ^ i
End If
ce = bscall(s, k, r, sg, t)
Loop
bisection = sg
End Function

Public Function newton(c, s, k, r, sg0, t)
ce = bscall(s, k, r, sg0, t)
sg = sg0
While Abs(c - ce) > 0.001
d1 = Log(s / k) + (r + sg ^ 2 / 2) * t
d1 = d1 / sg / Sqr(t)
vega = s * Sqr(t / 3.14159) * Exp(-d1 ^ 2 / 2)
dv = (c - ce) / vega
sg = sg + dv
ce = bscall(s, k, r, sg, t)
Wend
newton = sg
End Function
Public Function hedging(s, k, u, r, sg, t, n)
Dim st()
ReDim st(n)
st(0) = s
dt = t / n
d11 = (Log(st(0) / k) + (r + sg ^ 2) * t) / Sqr(t) / sg
nd11 = Application.WorksheetFunction.NormSDist(d11)
cost = nd11 * st(0)
For i = 1 To n - 1
randn = Application.WorksheetFunction.NormInv(Rnd(), 0, 1)
st(i) = st(i - 1) * Exp((u - sg ^ 2 / 2) * dt + sg * Sqr(dt) * randn)
d12 = (Log(st(i) / k) + (r + sg ^ 2) * (t - i * dt)) / Sqr(t - i * dt) / sg
nd12 = Application.WorksheetFunction.NormSDist(d12)
cost = cost * Exp(r * dt) + (nd12 - nd11) * st(i)
nd11 = nd12
Next
st(n) = st(n - 1) * Exp((u - sg ^ 2 / 2) * dt + sg * Sqr(dt) * randn)
If st(n) >= k Then
nd12 = 1
cost = cost * Exp(r * dt) + (nd12 - nd11) * st(n) - k
Else
nd12 = 0
cost = cost * Exp(r * dt) + (nd12 - nd11) * st(n)
End If
hedging = cost * Exp(-r * t)
End Function
Public Function participation(a0, rg, r, sg, t)
d1 = (Log(a0 / (a0 + Exp(rg * t) - 1)) + (r + sg ^ 2 / 2) * t) / (sg * Sqr(t))
d2 = d1 - sg * Sqr(t)
v = Exp((rg - r) * t) + a0 * Application.WorksheetFunction.NormSDist(d1) - Exp(-r * t) * (a0 + Exp(rg * t) - 1) * Application.WorksheetFunction.NormSDist(d2)
If v < 1 Then
a0 = a0 + 1
d1 = (Log(a0 / (a0 + Exp(rg * t) - 1)) + (r + sg ^ 2 / 2) * t) / (sg * Sqr(t))
d2 = d1 - sg * Sqr(t)
v = Exp((rg - r) * t) + a0 * Application.WorksheetFunction.NormSDist(d1) - Exp(-r * t) * (a0 + Exp(rg * t) - 1) * Application.WorksheetFunction.NormSDist(d2)
End If
a = a0
Do While Abs(v - 1) > 0.001
i = i + 1
If v > 1 Then
a = a - a0 / 2 ^ i
Else
a = a + a0 / 2 ^ i
End If
d1 = (Log(a / (a + Exp(rg * t) - 1)) + (r + sg ^ 2 / 2) * t) / (sg * Sqr(t))
d2 = d1 - sg * Sqr(t)
v = Exp((rg - r) * t) + a * Application.WorksheetFunction.NormSDist(d1) - Exp(-r * t) * (a + Exp(rg * t) - 1) * Application.WorksheetFunction.NormSDist(d2)
Loop
participation = a
End Function

Public Function exchangeoption(sa, sb, rho, r, sga, sgb, t)
b2 = (sga ^ 2 - 2 * rho * sga * sgb + sgb ^ 2) * t
d1 = (Log(sa / sb) + b2 / 2) / Sqr(b2)
d2 = d1 - Sqr(b2)
nd1 = Application.WorksheetFunction.NormSDist(d1)
nd2 = Application.WorksheetFunction.NormSDist(d2)
exchangeoption = sa * nd1 - sb * nd2
End Function
Public Function gapcall(s, k1, k2, r, sg, t)
d1 = (Log(s / k2) + (r + sg ^ 2) * t) / Sqr(t) / sg
d2 = d1 - sg * Sqr(t)
nd1 = Application.WorksheetFunction.NormSDist(d1)
nd2 = Application.WorksheetFunction.NormSDist(d2)
gapcall = s * nd1 - k1 * Exp(-r * t) * nd2
End Function