Other Greeks
Public Sub McOptV(F As Double, K As Double, T As Double, V As Double, R As Double, _
Cp As String, CalcType As String, Steps As Integer, _
Px As Double, Delta As Double, Gamma As Double, Theta As Double, Vega As Double)
' Calculates and returns PX (PREMIUM), DELTA, GAMMA, THETA and VEGA from
' Binomial calculation fixed as 50 (wSteps)
' F Future price
' K Strike
' T Time in years to expiry
' V Annualised volatility
' R Continuously componded dicount rate
' Cp 'C'all or 'P'ut
' Calctype 'E'uropean, 'A'merican or 'Z' european binomial
' Steps No. of binomial steps
Dim A(0 To 2001) As Double
Dim FSHIFT As Double, TSHIFT As Double, VSHIFT As Double
Dim F_PLUS As Double, F_MINUS As Double, T_MINUS As Double, V_PLUS As Double
Dim PX_NOW As Double, GkPx As Double, GkDelta As Double, PX_PLUS As Double
Dim BinPx As Double, DELTA_PLUS As Double, PX_MINUS As Double
Dim DELTA_MINUS As Double, BinDelta As Double, FF As Double
Dim FK As Double, FT As Double, FV As Double, ONE As Double, Discount As Double
Dim X1 As Double, X2 As Double, CUMX1 As Double, CUMX2 As Double
Dim z As Double, X As Double, K1 As Double, Rval As Double, PX_ODD As Double
Dim DELTA_ODD As Double, PX_EVEN As Double, FN As Double, TN As Double
Dim U As Double, D As Double, P As Double, Q As Double, S As Double
Dim VEG As Double, DELTA_EVEN As Double
Dim wx As Integer, wi As Integer, wj As Integer, wSteps As Integer
On Error GoTo Errors
GoSub 5100 ' Initialise
If CalcType = "E" Then GoSub 6000 ' European style
If CalcType = "A" Or CalcType = "Z" Then GoSub 6100 ' Binomial
Exit Sub
5100 '******************************************
' I N I T I A L I S E
' -------------------
'
Px = 0
Delta = 0
Gamma = 0
Theta = 0
Vega = 0
Cp$ = Left$(Cp$, 1)
CalcType = Left$(CalcType$, 1)
If InStr(1, "CP", Cp$) = 0 Then Exit Sub
If InStr(1, "EAZ", CalcType) = 0 Then Exit Sub
FSHIFT = F * 0.001
TSHIFT = 1 / 365
VSHIFT = 0.01
F_PLUS = F + FSHIFT
F_MINUS = F - FSHIFT
T_MINUS = T - TSHIFT
V_PLUS = V + VSHIFT
Return
6000 '******************************************
' E U R O P E A N S T Y L E
' -----------------------------
'
FF = F: FK = K: FT = T: FV = V
GoSub EuroStyle ' Price/delta
Px = GkPx
PX_NOW = GkPx
Delta = GkDelta
FF = F_PLUS: FK = K: FT = T: FV = V
GoSub EuroStyle ' Price/delta on fut price + .1%
PX_PLUS = GkPx
DELTA_PLUS = GkDelta
FF = F_MINUS: FK = K: FT = T: FV = V
GoSub EuroStyle ' Price/delta on fut price - .1%
PX_MINUS = GkPx
DELTA_MINUS = GkDelta
Gamma = (DELTA_PLUS - DELTA_MINUS) / (2 * FSHIFT)
FF = F: FK = K: FT = T_MINUS: FV = V
GoSub EuroStyle ' Price/delta on time - 1 day
Theta = GkPx - PX_NOW
FF = F: FK = K: FT = T: FV = V_PLUS
GoSub EuroStyle ' Price/delta on volatity + .01
Vega = GkPx - PX_NOW
Return
6100 '***************************************************************
' B I N O M I A L S T Y L E
' ----------------------------
'
FF = F: FK = K: FT = T: FV = V
GoSub BinOEStyle ' Price/delta
Px = BinPx
PX_NOW = BinPx
Delta = BinDelta
FF = F_PLUS: FK = K: FT = T: FV = V
GoSub BinOEStyle ' Price/delta on fut price + .1%
PX_PLUS = BinPx
DELTA_PLUS = BinDelta
FF = F_MINUS: FK = K: FT = T: FV = V
GoSub BinOEStyle ' Price/delta on fut price - .1%
PX_MINUS = BinPx
DELTA_MINUS = BinDelta
Gamma = (DELTA_PLUS - DELTA_MINUS) / (2 * FSHIFT)
FF = F: FK = K: FT = T_MINUS: FV = V
GoSub BinOEStyle ' Price/delta on time - 1 day
Theta = BinPx - PX_NOW
FF = F: FK = K: FT = T: FV = V_PLUS
GoSub BinOEStyle ' Price/delta on volatity + .01
Vega = BinPx - PX_NOW
Return
EuroStyle:
' European style calc (GK), returns GkPx and GkDelta
If FT <= 0 Then
GkDelta = 0
If Cp = "C" Then GkPx = FnMax(FF - FK, 0)
If Cp = "P" Then GkPx = FnMax(FK - FF, 0)
Return
End If
ONE = 0
If Cp = "P" Then ONE = 1
Discount = Exp(-R * FT)
X1 = (Log(FF / FK) + FV * FV / 2 * FT) / (FV * FT ^ 0.5)
X2 = X1 - FV * FT ^ 0.5
CUMX1 = FnCum(X1) - ONE
CUMX2 = FnCum(X2) - ONE
GkPx = Discount * (FF * CUMX1 - FK * CUMX2)
GkDelta = Discount * CUMX1
Return
BinOEStyle:
' Binomial calc on odd and even. Returns BinPx and BinDelta
wSteps = Steps
GoSub BinCalc
PX_ODD = BinPx
DELTA_ODD = BinDelta
wSteps = Steps + 1
GoSub BinCalc
PX_EVEN = BinPx
DELTA_EVEN = BinDelta
BinPx = (PX_ODD + PX_EVEN) / 2
BinDelta = (DELTA_ODD + DELTA_EVEN) / 2
Return
BinCalc:
' Binomial calculation, returns BinPx and BinDelta
If FT <= 0 Then
BinDelta = 0
If Cp = "C" Then BinPx = FnMax(FF - FK, 0)
If Cp = "P" Then BinPx = FnMax(FK - FF, 0)
Return
End If
TN = FT / wSteps
U = Exp(FV * TN ^ 0.5)
D = 1 / U
P = (Exp(R * TN) / Exp(R * TN) - D) / (U - D)
Q = 1 - P
Select Case Cp
Case "C"
For wi = wSteps To 0 Step -1
A(wi) = FnMax(0, FF * U ^ wi * D ^ (wSteps - wi) - FK)
Next wi
Case "P"
For wi = wSteps To 0 Step -1
A(wi) = FnMax(0, FK - FF * U ^ wi * D ^ (wSteps - wi))
Next wi
End Select
If CalcType = "Z" Then
wx = 0
For wj = 1 To wSteps Step 1
S = FF * D ^ (wSteps - wj + 1) / U
For wi = 0 To (wSteps - wj) Step 1
S = S * U / D
A(wi) = (P * A(wi + 1) + Q * A(wi)) * Exp(-R * TN)
Next wi
If wj = wSteps - 1 Then BinDelta = (A(1) - A(0)) / (FF * U - FF * D)
Next wj
BinPx = A(0)
End If
If CalcType = "A" Then
wx = 0
For wj = 1 To wSteps Step 1
S = FF * D ^ (wSteps - wj + 1) / U
For wi = 0 To (wSteps - wj) Step 1
S = S * U / D
If Cp = "C" Then A(wi) = FnMax(S - FK, (P * A(wi + 1) + Q * A(wi)) * Exp(-R * TN))
If Cp = "P" Then A(wi) = FnMax(FK - S, (P * A(wi + 1) + Q * A(wi)) * Exp(-R * TN))
Next wi
If wj = (wSteps - 1) Then BinDelta = (A(1) - A(0)) / (FF * U - FF * D)
Next wj
BinPx = A(0)
End If
Return
Errors:
Resume Errors2
Errors2:
Px = 0
Delta = 0
Gamma = 0
Theta = 0
VEG = 0
Exit Sub
End Sub
Function FnCum(z As Double) As Double
' Used in McOptV
Dim Rval As Double, K1 As Double, X As Double
Dim Alpha As Double, Pie As Double, a1 As Double, a2 As Double, a3 As Double
Alpha = 0.33267
a1 = 0.4361836
a2 = -0.1201676
a3 = 0.937298
Pie = 3.141593
X = Abs(z)
K1 = 1 / (1 + Alpha * X)
Rval = 1 - 1 / (2 * Pie) ^ 0.5 * Exp(-X * X / 2) * (a1 * K1 + a2 * K1 * K1 + a3 * K1 * K1 * K1)
If z < 0 Then Rval = 1 - Rval
FnCum = Rval
End Function
Function FnMax(N1 As Double, N2 As Double) As Double
If N1 > N2 Then
FnMax = N1
Else
FnMax = N2
End If
End Function