fExoticOptions/ 0000755 0001762 0000144 00000000000 13203517731 013231 5 ustar ligges users fExoticOptions/inst/ 0000755 0001762 0000144 00000000000 13203477730 014212 5 ustar ligges users fExoticOptions/inst/COPYRIGHT.html 0000644 0001762 0000144 00000020411 11645005270 016440 0 ustar ligges users
Rmetrics::COPYRIGHT
Rmetrics
Copyrights
2005-12-18 Built 221.10065
________________________________________________________________________________
Copyrights (C) for
R:
see R's copyright and license file
Version R 2.0.0 claims:
- The stub packages from 1.9.x have been removed.
- All the datasets formerly in packages 'base' and 'stats' have
been moved to a new package 'datasets'.
- Package 'graphics' has been split into 'grDevices' (the graphics
devices shared between base and grid graphics) and 'graphics'
(base graphics).
- Packages must have been re-installed for this version, and
library() will enforce this.
- Package names must now be given exactly in library() and
require(), regardless of whether the underlying file system is
case-sensitive or not.
________________________________________________________________________________
for
Rmetrics:
(C) 1999-2005, Diethelm Wuertz, GPL
Diethelm Wuertz
www.rmetrics.org
info@rmetrics.org
________________________________________________________________________________
for non default loaded basic packages part of R's basic distribution
MASS:
Main Package of Venables and Ripley's MASS.
We assume that MASS is available.
Package 'lqs' has been returned to 'MASS'.
S original by Venables & Ripley.
R port by Brian Ripley .
Earlier work by Kurt Hornik and Albrecht Gebhardt.
methods:
Formally defined methods and classes for R objects, plus other
programming tools, as described in the reference "Programming
with Data" (1998), John M. Chambers, Springer NY.
R Development Core Team.
mgcv:
Routines for GAMs and other generalized ridge regression
with multiple smoothing parameter selection by GCV or UBRE.
Also GAMMs by REML or PQL. Includes a gam() function.
Simon Wood
nnet:
Feed-forward Neural Networks and Multinomial Log-Linear Models
Original by Venables & Ripley.
R port by Brian Ripley .
Earlier work by Kurt Hornik and Albrecht Gebhardt.
________________________________________________________________________________
for the code partly included as builtin functions from other R ports:
fBasics:CDHSC.F
GRASS program for distributional testing.
By James Darrell McCauley
Original Fortran Source by Paul Johnson EZ006244@ALCOR.UCDAVIS.EDU>
fBasics:nortest
Five omnibus tests for the composite hypothesis of normality
R-port by Juergen Gross
fBasics:SYMSTB.F
Fast numerical approximation to the Symmetric Stable distribution
and density functions.
By Hu McCulloch
fBasics:tseries
Functions for time series analysis and computational finance.
Compiled by Adrian Trapletti
fCalendar:date
The tiny C program from Terry Therneau is used
R port by Th. Lumley ,
K. Halvorsen , and
Kurt Hornik
fCalendar:holidays
The holiday information was collected from the internet and
governmental sources obtained from a few dozens of websites
fCalendar:libical
Libical is an Open Source implementation of the IETF's
iCalendar Calendaring and Scheduling protocols. (RFC 2445, 2446,
and 2447). It parses iCal components and provides a C API for
manipulating the component properties, parameters, and subcomponents.
fCalendar:vtimezone
Olsen's VTIMEZONE database consists of data files are released under
the GNU General Public License, in keeping with the license options of
libical.
fSeries:bdstest.c
C Program to compute the BDS Test.
Blake LeBaron
fSeries:fracdiff
R functions, help pages and the Fortran Code for the 'fracdiff'
function are included.
S original by Chris Fraley
R-port by Fritz Leisch
since 2003-12: Martin Maechler
fSeries:lmtest
R functions and help pages for the linear modelling tests are included .
Compiled by Torsten Hothorn ,
Achim Zeileis , and
David Mitchell
fSeries:mda
R functions, help pages and the Fortran Code for the 'mars' function
are implemeted.
S original by Trevor Hastie & Robert Tibshirani,
R port by Friedrich Leisch, Kurt Hornik and Brian D. Ripley
fSeries:modreg
Brian Ripley and the R Core Team
fSeries:polspline
R functions, help pages and the C/Fortran Code for the 'polymars'
function are implemented
Charles Kooperberg
fSeries:systemfit
Simultaneous Equation Estimation Package.
R port by Jeff D. Hamann and
Arne Henningsen
fSeries:tseries
Functions for time series analysis and computational finance.
Compiled by Adrian Trapletti
fSeries:UnitrootDistribution:
The program uses the Fortran routine and the tables
from J.G. McKinnon.
fSeries:urca
Unit root and cointegration tests for time series data.
R port by Bernhard Pfaff .
fExtremes:evd
Functions for extreme value distributions.
R port by Alec Stephenson
Function 'fbvpot' by Chris Ferro.
fExtremes:evir
Extreme Values in R
Original S functions (EVIS) by Alexander McNeil
R port by Alec Stephenson
fExtremes:ismev
An Introduction to Statistical Modeling of Extreme Values
Original S functions by Stuart Coles
R port/documentation by Alec Stephenson
fOptions
Option Pricing formulas are implemented along the book and
the Excel spreadsheets of E.G. Haug, "The Complete Guide to Option
Pricing"; documentation is partly taken from www.derivicom.com which
implements a C Library based on Haug. For non-academic and commercial
use we recommend the professional software from "www.derivicom.com".
fOptions:SOBOL.F
ACM Algorithm 659 by P. Bratley and B.L. Fox
Extension on Algorithm 659 by S. Joe and F.Y. Kuo
fOptions:CGAMA.F
Complex gamma and related functions.
Fortran routines by Jianming Jin.
fOptions:CONHYP.F
Confluenet Hypergeometric and related functions.
ACM Algorithm 707 by mark Nardin, W.F. Perger, A. Bhalla
fPortfolio:mvtnorm
Multivariate Normal and T Distribution.
Alan Genz ,
Frank Bretz
R port by Torsten Hothorn
fPortfolio:quadprog
Functions to solve Quadratic Programming Problems.
S original by Berwin A. Turlach
R port by Andreas Weingessel
fPortfolio:sn
The skew-normal and skew-t distributions.
R port by Adelchi Azzalini
fPortfolio:tseries
Functions for time series analysis and computational finance.
Compiled by Adrian Trapletti
fExoticOptions/inst/unitTests/ 0000755 0001762 0000144 00000000000 13201353164 016204 5 ustar ligges users fExoticOptions/inst/unitTests/Makefile 0000644 0001762 0000144 00000000427 13203477730 017657 0 ustar ligges users PKG=fExoticOptions
TOP=../..
SUITE=doRUnit.R
R=R
all: inst test
inst: # Install package -- but where ?? -- will that be in R_LIBS ?
cd ${TOP}/..;\
${R} CMD INSTALL ${PKG}
test: # Run unit tests
export RCMDCHECK=FALSE;\
cd ${TOP}/tests;\
${R} --vanilla --slave < ${SUITE}
fExoticOptions/inst/unitTests/runit.BarrierOptions.R 0000644 0001762 0000144 00000011437 11645005270 022441 0 ustar ligges users
# This library is free software; you can redistribute it and/or
# modify it under the terms of the GNU Library General Public
# License as published by the Free Software Foundation; either
# version 2 of the License, or (at your option) any later version.
#
# This library is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU Library General Public License for more details.
#
# You should have received a copy of the GNU Library General
# Public License along with this library; if not, write to the
# Free Foundation, Inc., 59 Temple Place, Suite 330, Boston,
# MA 02111-1307 USA
# Copyrights (C)
# for this R-port:
# 1999 - 2007, Diethelm Wuertz, GPL
# Diethelm Wuertz
# info@rmetrics.org
# www.rmetrics.org
# for the code accessed (or partly included) from other R-ports:
# see R's copyright and license files
# for the code accessed (or partly included) from contributed R-ports
# and other sources
# see Rmetrics's copyright file
################################################################################
# FUNCTION: BARRIER OPTIONS:
# StandardBarrierOption Standard Barrier Option
# DoubleBarrierOption Double Barrier Option
# PTSingleAssetBarrierOption Partial Time Barrier Option
# TwoAssetBarrierOption Two Asset Barrier
# PTTwoAssetBarrierOption Partial Time TwoAsset Barrier Option
# LookBarrierOption Look Barrier Option
# DiscreteBarrierOption Discrete Adjusted Barrier Option
# SoftBarrierOption Soft Barrier Option
################################################################################
test.StandardBarrierOption =
function()
{
# Examples from Chapter 2.10 in E.G. Haug's Option Guide (1997)
# Standard Barrier Option [2.10.1]:
# down-and-out Barrier Call
StandardBarrierOption(TypeFlag = "cdo", S = 100, X = 90,
H = 95, K = 3, Time = 0.5, r = 0.08, b = 0.04, sigma = 0.25)
# Return Value:
return()
}
# ------------------------------------------------------------------------------
test.DoubleBarrierOption =
function()
{
# Double Barrier Option [2.10.2]:
DoubleBarrierOption(TypeFlag = "co", S = 100, X = 100, L = 50,
U = 150, Time = 0.25, r = 0.10, b = 0.10, sigma = 0.15,
delta1 = -0.1, delta2 = 0.1)
# Return Value:
return()
}
# ------------------------------------------------------------------------------
test.PTSingleAssetBarrierOption =
function()
{
# Partial Time Single-Asset Barrier Option [2.10.3]:
PTSingleAssetBarrierOption(TypeFlag = "coB1", S = 95, X = 110,
H = 100, time1 = 0.5, Time2 = 1, r = 0.20, b = 0.20,
sigma = 0.25)
# Return Value:
return()
}
# ------------------------------------------------------------------------------
test.TwoAssetBarrierOption =
function()
{
# Two Asset Barrier Option [2.10.4]:
TwoAssetBarrierOption(TypeFlag = "puo", S1 = 100, S2 = 100,
X = 110, H = 105, Time = 0.5, r = 0.08, b1 = 0.08, b2 = 0.08,
sigma1 = 0.2, sigma2 = 0.2, rho = -0.5)
# Return Value:
return()
}
# ------------------------------------------------------------------------------
test.PTTwoAssetBarrierOption =
function()
{
# PT Two Asset Barrier Option [2.10.5]:
PTTwoAssetBarrierOption(TypeFlag = "pdo", S1 = 100, S2 = 100,
X = 100, H = 85, time1 = 0.5, Time2 = 1, r = 0.1, b1 = 0.1,
b2 = 0.1, sigma1 = 0.25, sigma2 = 0.30, rho = -0.5)
# Return Value:
return()
}
# ------------------------------------------------------------------------------
test.LookBarrierOption =
function()
{
# Look Barrier Option [2.10.6]:
LookBarrierOption(TypeFlag = "cuo", S = 100, X = 100, H = 130,
time1 = 0.25, Time2 = 1, r = 0.1, b = 0.1, sigma = 0.15)
LookBarrierOption(TypeFlag = "cuo", S = 100, X = 100, H = 110,
time1 = 1, Time2 = 1, r = 0.1, b = 0.1, sigma = 0.30)
# Return Value:
return()
}
# ------------------------------------------------------------------------------
test.DiscreteBarrierOption =
function()
{
# Discrete Barrier Option [2.10.7]:
DiscreteBarrierOption(S = 100, H = 105, sigma = 0.25, dt = 0.1)
# Return Value:
return()
}
# ------------------------------------------------------------------------------
test.SoftBarrierOption =
function()
{
# Soft Barrier Option [2.10.8]:
SoftBarrierOption(TypeFlag = "cdo", S = 100, X = 100, L = 70,
U = 95, Time = 0.5, r = 0.1, b = 0.05, sigma = 0.20)
# Return Value:
return()
}
################################################################################
fExoticOptions/inst/unitTests/runit.BasicAsianOptions.R 0000644 0001762 0000144 00000005173 11645005270 023050 0 ustar ligges users
# This library is free software; you can redistribute it and/or
# modify it under the terms of the GNU Library General Public
# License as published by the Free Software Foundation; either
# version 2 of the License, or (at your option) any later version.
#
# This library is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU Library General Public License for more details.
#
# You should have received a copy of the GNU Library General
# Public License along with this library; if not, write to the
# Free Foundation, Inc., 59 Temple Place, Suite 330, Boston,
# MA 02111-1307 USA
# Copyrights (C)
# for this R-port:
# 1999 - 2007, Diethelm Wuertz, GPL
# Diethelm Wuertz
# info@rmetrics.org
# www.rmetrics.org
# for the code accessed (or partly included) from other R-ports:
# see R's copyright and license files
# for the code accessed (or partly included) from contributed R-ports
# and other sources
# see Rmetrics's copyright file
################################################################################
# FUNCTION: ASIAN OPTIONS:
# GeometricAverageRateOption Geometric Average Rate Option
# TurnbullWakemanAsianApproxOption Turnbull-Wakeman Approximated Asian Option
# LevyAsianApproxOption Levy Approximated Asian Option
################################################################################
test.GeometricAverageRateOption =
function()
{
# Examples from Chapter 2.12 in E.G. Haug's Option Guide (1997)
# Geometric Average Rate Option:
GeometricAverageRateOption(TypeFlag = "p", S = 80, X = 85,
Time = 0.25, r = 0.05, b = 0.08, sigma = 0.20)
# Return Value:
return()
}
# ------------------------------------------------------------------------------
test.TurnbullWakemanAsianApproxOption =
function()
{
# Turnbull Wakeman Approximation:
TurnbullWakemanAsianApproxOption(TypeFlag = "p", S = 90, SA = 88,
X = 95, Time = 0.50, time = 0.25, tau = 0.0, r = 0.07,
b = 0.02, sigma = 0.25)
# Return Value:
return()
}
# ------------------------------------------------------------------------------
test.LevyAsianApproxOption =
function()
{
# Levy Asian Approximation:
LevyAsianApproxOption(TypeFlag = "c", S = 100, SA = 100, X = 105,
Time = 0.75, time = 0.50, r = 0.10, b = 0.05, sigma = 0.15)
# Return Value:
return()
}
################################################################################
fExoticOptions/inst/unitTests/runit.MultipleExercisesOptions.R 0000644 0001762 0000144 00000011737 11645005270 024524 0 ustar ligges users
# This library is free software; you can redistribute it and/or
# modify it under the terms of the GNU Library General Public
# License as published by the Free Software Foundation; either
# version 2 of the License, or (at your option) any later version.
#
# This library is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU Library General Public License for more details.
#
# You should have received a copy of the GNU Library General
# Public License along with this library; if not, write to the
# Free Foundation, Inc., 59 Temple Place, Suite 330, Boston,
# MA 02111-1307 USA
# Copyrights (C)
# for this R-port:
# 1999 - 2007, Diethelm Wuertz, GPL
# Diethelm Wuertz
# info@rmetrics.org
# www.rmetrics.org
# for the code accessed (or partly included) from other R-ports:
# see R's copyright and license files
# for the code accessed (or partly included) from contributed R-ports
# and other sources
# see Rmetrics's copyright file
################################################################################
# FUNCTION: MULTIPLE EXERCISES OPTIONS:
# ExecutiveStockOption Executive Stock Option
# ForwardStartOption Forward Start Option
# RatchetOption Ratchet [Compound] Option
# TimeSwitchOption Time Switch Option
# SimpleChooserOption Simple Chooser Option
# ComplexChooserOption Complex Chooser Option
# OptionOnOption Options On Options
# HolderExtendibleOption Holder Extendible Option
# WriterExtendibleOption Writer Extendible Option
################################################################################
test.ExecutiveStockOption =
function()
{
# Examples from Chapter 2.1 - 2.7 in E.G. Haug's Option Guide (1997)
# ExecutiveStockOption [2.1]:
ExecutiveStockOption(TypeFlag = "c", S = 60, X = 64, Time = 2,
r = 0.07, b = 0.07-0.03, sigma = 0.38, lambda = 0.15)
# Return Value:
return()
}
# ------------------------------------------------------------------------------
test.ForwardStartOption =
function()
{
# ForwardStartOption [2.2]:
ForwardStartOption(TypeFlag = "c", S = 60, alpha = 1.1,
time1 = 1, Time2 = 1/4, r = 0.08, b = 0.08-0.04, sigma = 0.30)
# Return Value:
return()
}
# ------------------------------------------------------------------------------
test.RatchetOption =
function()
{
# Ratchet Option [2.3]:
RatchetOption(TypeFlag = "c", S = 60, alpha = 1.1, time1 = c(1.00, 0.75),
Time2 = c(0.75, 0.50), r = 0.08, b = 0.04, sigma = 0.30)
# Return Value:
return()
}
# ------------------------------------------------------------------------------
test.TimeSwitchOption =
function()
{
# Time Switch Option [2.4]:
TimeSwitchOption(TypeFlag = "c", S = 100, X = 110, Time = 1,
r = 0.06, b = 0.06, sigma = 0.26, A = 5, m = 0, dt = 1/365)
# Return Value:
return()
}
# ------------------------------------------------------------------------------
test.SimpleChooserOption =
function()
{
# Simple Chooser Option [2.5.1]:
SimpleChooserOption(S = 50, X = 50, time1 = 1/4, Time2 = 1/2,
r = 0.08, b = 0.08, sigma = 0.25)
# Return Value:
return()
}
# ------------------------------------------------------------------------------
test.ComplexChooserOption =
function()
{
# Complex Chooser Option [2.5.2]:
ComplexChooserOption(S = 50, Xc = 55, Xp = 48, Time = 0.25,
Timec = 0.50, Timep = 0.5833, r = 0.10, b = 0.1-0.05,
sigma = 0.35, doprint = TRUE)
# Return Value:
return()
}
# ------------------------------------------------------------------------------
test.OptionOnOption =
function()
{
# Option On Option [2.6]:
OptionOnOption(TypeFlag = "pc", S = 500, X1 = 520, X2 = 50,
time1 = 1/2, Time2 = 1/4, r = 0.08, b = 0.08-0.03, sigma = 0.35)
# Return Value:
return()
}
# ------------------------------------------------------------------------------
test.HolderExtendibleOption =
function()
{
# Holder Extendible Option [2.7.1]:
HolderExtendibleOption(TypeFlag = "c", S = 100, X1 = 100,
X2 = 105, time1 = 0.50, Time2 = 0.75, r = 0.08, b = 0.08,
sigma = 0.25, A = 1)
# Return Value:
return()
}
# ------------------------------------------------------------------------------
test.WriterExtendibleOption =
function()
{
# Writer Extendible Option [2.7.2]:
WriterExtendibleOption(TypeFlag = "c", S = 80, X1 = 90, X2 = 82,
time1 = 0.50, Time2 = 0.75, r = 0.10, b = 0.10, sigma = 0.30)
# Return Value:
return()
}
################################################################################
fExoticOptions/inst/unitTests/runit.BinaryOptions.R 0000644 0001762 0000144 00000010445 11645005270 022275 0 ustar ligges users
# This library is free software; you can redistribute it and/or
# modify it under the terms of the GNU Library General Public
# License as published by the Free Software Foundation; either
# version 2 of the License, or (at your option) any later version.
#
# This library is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU Library General Public License for more details.
#
# You should have received a copy of the GNU Library General
# Public License along with this library; if not, write to the
# Free Foundation, Inc., 59 Temple Place, Suite 330, Boston,
# MA 02111-1307 USA
# Copyrights (C)
# for this R-port:
# 1999 - 2007, Diethelm Wuertz, GPL
# Diethelm Wuertz
# info@rmetrics.org
# www.rmetrics.org
# for the code accessed (or partly included) from other R-ports:
# see R's copyright and license files
# for the code accessed (or partly included) from contributed R-ports
# and other sources
# see Rmetrics's copyright file
################################################################################
# FUNCTION: BINARY OPTIONS:
# GapOption Gap Option
# CashOrNothingOption Cash Or Nothing Option
# TwoAssetCashOrNothingOption Two Asset Cash-Or Nothing Option
# AssetOrNothingOption Asset Or Nothing Option
# SuperShareOption Super Share Option
# BinaryBarrierOption Binary Barrier Option
################################################################################
test.GapOption =
function()
{
# Examples from Chapter 2.11 in E.G. Haug's Option Guide (1997)
# Gap Option [2.11.1]:
GapOption(TypeFlag = "c", S = 50, X1 = 50, X2 = 57, Time = 0.5,
r = 0.09, b = 0.09, sigma = 0.20)
# Return Value:
return()
}
# ------------------------------------------------------------------------------
test.CashOrNothingOption =
function()
{
# Cash Or Nothing Option [2.11.2]:
CashOrNothingOption(TypeFlag = "p", S = 100, X = 80, K = 10,
Time = 9/12, r = 0.06, b = 0, sigma = 0.35)
# Two Asset Cash Or Nothing Option [2.11.3]:
# Type 1 - call:
TwoAssetCashOrNothingOption(TypeFlag = "c", S1 = 100, S2 = 100,
X1 = 110, X2 = 90, K = 10, Time = 0.5, r = 0.10, b1 = 0.05,
b2 = 0.06, sigma1 = 0.20, sigma2 = 0.25, rho = 0.5)
# Type 2 - put:
TwoAssetCashOrNothingOption(TypeFlag = "p", S1 = 100, S2 = 100,
X1 = 110, X2 = 90, K = 10, Time = 0.5, r = 0.10, b1 = 0.05,
b2 = 0.06, sigma1 = 0.20, sigma2 = 0.25, rho = -0.5)
# Type 3 - down-up:
TwoAssetCashOrNothingOption(TypeFlag = "ud", S1 = 100, S2 = 100,
X1 = 110, X2 = 90, K = 10, Time = 1, r = 0.10, b1 = 0.05,
b2 = 0.06, sigma1 = 0.20, sigma2 = 0.25, rho = 0)
# Type 4 - up-down:
TwoAssetCashOrNothingOption(TypeFlag = "du", S1 = 100, S2 = 100,
X1 = 110, X2 = 90, K = 10, Time = 1, r = 0.10, b1 = 0.05,
b2 = 0.06, sigma1 = 0.20, sigma2 = 0.25, rho = 0)
# Return Value:
return()
}
# ------------------------------------------------------------------------------
test.AssetOrNothingOption =
function()
{
# Asset Or Nothing Option [2.11.4]:
AssetOrNothingOption(TypeFlag = "p", S = 70, X = 65, Time = 0.5,
r = 0.07, b = 0.07 - 0.05, sigma = 0.27)
# Return Value:
return()
}
# ------------------------------------------------------------------------------
test.SuperShareOption =
function()
{
# Super Share Option [2.11.5]:
SuperShareOption(S = 100, XL = 90, XH = 110, Time = 0.25, r = 0.10,
b = 0, sigma = 0.20)
# Return Value:
return()
}
# ------------------------------------------------------------------------------
test.BinaryBarrierOption =
function()
{
# Binary Barrier Option [2.11.6]:
BinaryBarrierOption(TypeFlag = "6", S = 95, X=102, H = 100,
K = 15, Time = 0.5, r = 0.1, b = 0.1, sigma = 0.20)
BinaryBarrierOption(TypeFlag = "12", S = 95, X = 98, H = 100,
K = 15, Time = 0.5, r = 0.1, b = 0.1, sigma = 0.20)
# Return Value:
return()
}
################################################################################
fExoticOptions/inst/unitTests/runit.MultipleAssetsOptions.R 0000644 0001762 0000144 00000010467 11645005270 024033 0 ustar ligges users
# This library is free software; you can redistribute it and/or
# modify it under the terms of the GNU Library General Public
# License as published by the Free Software Foundation; either
# version 2 of the License, or (at your option) any later version.
#
# This library is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU Library General Public License for more details.
#
# You should have received a copy of the GNU Library General
# Public License along with this library; if not, write to the
# Free Foundation, Inc., 59 Temple Place, Suite 330, Boston,
# MA 02111-1307 USA
# Copyrights (C)
# for this R-port:
# 1999 - 2007, Diethelm Wuertz, GPL
# Diethelm Wuertz
# info@rmetrics.org
# www.rmetrics.org
# for the code accessed (or partly included) from other R-ports:
# see R's copyright and license files
# for the code accessed (or partly included) from contributed R-ports
# and other sources
# see Rmetrics's copyright file
################################################################################
# FUNCTION: MULTI ASSET OPTION:
# TwoAssetCorrelationOption Two Asset Correlation Option
# [ExchangeOneForAnotherOption] [Exchange One For Another Option]
# EuropeanExchangeOption European Exchange Optionn
# AmericanExchangeOption American Exchange Option
# ExchangeOnExchangeOption Exchange Exchange Option
# TwoRiskyAssetsOption Option On The MinMax
# SpreadApproxOption Spread Approximated Option
################################################################################
test.TwoAssetCorrelationOption =
function()
{
# Examples from Chapter 2.8 in E.G. Haug's Option Guide (1997)
# Two Asset Correlation Options [2.8.1]:
TwoAssetCorrelationOption(TypeFlag = "c", S1 = 52, S2 = 65,
X1 = 50, X2 = 70, Time = 0.5, r = 0.10, b1 = 0.10, b2 = 0.10,
sigma1 = 0.2, sigma2 = 0.3, rho = 0.75)
# Return Value:
return()
}
# ------------------------------------------------------------------------------
test.EuropeanExchangeOption =
function()
{
# European Exchange Options [2.8.2]:
EuropeanExchangeOption(S1 = 22, S2 = 0.20, Q1 = 1, Q2 = 1,
Time = 0.1, r = 0.1, b1 = 0.04, b2 = 0.06, sigma1 = 0.2,
sigma2 = 0.25, rho = -0.5)
# Return Value:
return()
}
# ------------------------------------------------------------------------------
test.AmericanExchangeOption =
function()
{
# American Exchange Options [2.8.2]:
AmericanExchangeOption(S1 = 22, S2 = 0.20, Q1 = 1, Q2 = 1,
Time = 0.1, r = 0.1, b1 = 0.04, b2 = 0.06, sigma1 = 0.2,
sigma2 = 0.25, rho = -0.5)
# Return Value:
return()
}
# ------------------------------------------------------------------------------
test.ExchangeOnExchangeOption =
function()
{
# Exchange Options On Exchange Options [2.8.3]:
for (flag in 1:4) print(
ExchangeOnExchangeOption(TypeFlag = as.character(flag),
S1 = 105, S2 = 100, Q = 0.1, time1 = 0.75, Time2 = 1.0, r = 0.1,
b1 = 0.10, b2 = 0.10, sigma1 = 0.20, sigma2 = 0.25, rho = -0.5))
# Return Value:
return()
}
# ------------------------------------------------------------------------------
test.TwoRiskyAssetsOption =
function()
{
# Two Risky Assets Options [2.8.4]:
TwoRiskyAssetsOption(TypeFlag = "cmax", S1 = 100, S2 = 105,
X = 98, Time = 0.5, r = 0.05, b1 = -0.01, b2 = -0.04,
sigma1 = 0.11, sigma2 = 0.16, rho = 0.63)
TwoRiskyAssetsOption(TypeFlag = "pmax", S1 = 100, S2 = 105,
X = 98, Time = 0.5, r = 0.05, b1 = -0.01, b2 = -0.04,
sigma1 = 0.11, sigma2 = 0.16, rho = 0.63)
# Return Value:
return()
}
# ------------------------------------------------------------------------------
test.SpreadApproxOption =
function()
{
# Spread-Option Approximation [2.8.5]:
SpreadApproxOption(TypeFlag = "c", S1 = 28, S2 = 20, X = 7,
Time = 0.25, r = 0.05, sigma1 = 0.29, sigma2 = 0.36, rho = 0.42)
# Return Value:
return()
}
################################################################################
fExoticOptions/inst/unitTests/runit.CurrencyTranslatedOptions.R 0000644 0001762 0000144 00000006127 11645005270 024667 0 ustar ligges users
# This library is free software; you can redistribute it and/or
# modify it under the terms of the GNU Library General Public
# License as published by the Free Software Foundation; either
# version 2 of the License, or (at your option) any later version.
#
# This library is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU Library General Public License for more details.
#
# You should have received a copy of the GNU Library General
# Public License along with this library; if not, write to the
# Free Foundation, Inc., 59 Temple Place, Suite 330, Boston,
# MA 02111-1307 USA
# Copyrights (C)
# for this R-port:
# 1999 - 2007, Diethelm Wuertz, GPL
# Diethelm Wuertz
# info@rmetrics.org
# www.rmetrics.org
# for the code accessed (or partly included) from other R-ports:
# see R's copyright and license files
# for the code accessed (or partly included) from contributed R-ports
# and other sources
# see Rmetrics's copyright file
################################################################################
# FUNCTION: CURRENCY TRANSLATED OPTIONS:
# FEInDomesticFXOption FX In Domestic Currency
# QuantoOption Quanto Option
# EquityLinkedFXOption EquityLinked FX Option
# TakeoverFXOption Takeover FX Option
################################################################################
test.FEInDomesticFXOption =
function()
{
# Examples from Chapter 2.13 in E.G. Haug's Option Guide (1997)
# Foreign Equity Options Struck in Domestic Currency [2.13.1]:
FEInDomesticFXOption(TypeFlag = "c", S = 100, E = 1.5,
X = 160, Time = 0.5, r = 0.08, q = 0.05, sigmaS = 0.20,
sigmaE = 0.12, rho = 0.45)
# Return Value:
return()
}
# ------------------------------------------------------------------------------
test.QuantoOption =
function()
{
# Fixed Exchange-Rate Foreign-Equity Option [2.13.2]:
QuantoOption(TypeFlag = "c", S = 100, Ep = 1.5, X = 105,
Time = 0.5, r = 0.08, rf = 0.05, q = 0.04, sigmaS= 0.2,
sigmaE = 0.10, rho = 0.30)
# Return Value:
return()
}
# ------------------------------------------------------------------------------
test.EquityLinkedFXOption =
function()
{
# Equity Linked Foreign Exchange Option [2.13.3]:
EquityLinkedFXOption(TypeFlag = "p", E = 1.5, S = 100,
X = 1.52, Time = 0.25, r = 0.08, rf = 0.05, q = 0.04,
sigmaS = 0.20, sigmaE = 0.12, rho = -0.40)
# Return Value:
return()
}
# ------------------------------------------------------------------------------
test.TakeoverFXOption =
function()
{
# Takeover Foreign-Exchange Option [2.13.4]:
TakeoverFXOption(V = 100, B = 100, E = 1.5, X = 1.55, Time = 1,
r = 0.08, rf = 0.06, sigmaV = 0.20, sigmaE = 0.25, rho = 0.1)
# Return Value:
return()
}
################################################################################
fExoticOptions/inst/unitTests/runTests.R 0000644 0001762 0000144 00000004536 11645005270 020170 0 ustar ligges users pkg <- "fExoticOptions"
if(require("RUnit", quietly = TRUE))
{
library(package=pkg, character.only = TRUE)
if(!(exists("path") && file.exists(path)))
path <- system.file("unitTests", package = pkg)
## --- Testing ---
## Define tests
testSuite <- defineTestSuite(name = paste(pkg, "unit testing"),
dirs = path)
if(interactive()) {
cat("Now have RUnit Test Suite 'testSuite' for package '",
pkg, "' :\n", sep='')
str(testSuite)
cat('', "Consider doing",
"\t tests <- runTestSuite(testSuite)", "\nand later",
"\t printTextProtocol(tests)", '', sep = "\n")
} else {
## run from shell / Rscript / R CMD Batch / ...
## Run
tests <- runTestSuite(testSuite)
if(file.access(path, 02) != 0) {
## cannot write to path -> use writable one
tdir <- tempfile(paste(pkg, "unitTests", sep="_"))
dir.create(tdir)
pathReport <- file.path(tdir, "report")
cat("RUnit reports are written into ", tdir, "/report.(txt|html)",
sep = "")
} else {
pathReport <- file.path(path, "report")
}
## Print Results:
printTextProtocol(tests, showDetails = FALSE)
printTextProtocol(tests, showDetails = FALSE,
fileName = paste(pathReport, "Summary.txt", sep = ""))
printTextProtocol(tests, showDetails = TRUE,
fileName = paste(pathReport, ".txt", sep = ""))
## Print HTML Version to a File:
## printHTMLProtocol has problems on Mac OS X
if (Sys.info()["sysname"] != "Darwin")
printHTMLProtocol(tests,
fileName = paste(pathReport, ".html", sep = ""))
## stop() if there are any failures i.e. FALSE to unit test.
## This will cause R CMD check to return error and stop
tmp <- getErrors(tests)
if(tmp$nFail > 0 | tmp$nErr > 0) {
stop(paste("\n\nunit testing failed (#test failures: ", tmp$nFail,
", R errors: ", tmp$nErr, ")\n\n", sep=""))
}
}
} else {
cat("R package 'RUnit' cannot be loaded -- no unit tests run\n",
"for package", pkg,"\n")
}
################################################################################
fExoticOptions/inst/unitTests/runit.LookbackOptions.R 0000644 0001762 0000144 00000007262 11645005270 022601 0 ustar ligges users
# This library is free software; you can redistribute it and/or
# modify it under the terms of the GNU Library General Public
# License as published by the Free Software Foundation; either
# version 2 of the License, or (at your option) any later version.
#
# This library is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU Library General Public License for more details.
#
# You should have received a copy of the GNU Library General
# Public License along with this library; if not, write to the
# Free Foundation, Inc., 59 Temple Place, Suite 330, Boston,
# MA 02111-1307 USA
# Copyrights (C)
# for this R-port:
# 1999 - 2007, Diethelm Wuertz, GPL
# Diethelm Wuertz
# info@rmetrics.org
# www.rmetrics.org
# for the code accessed (or partly included) from other R-ports:
# see R's copyright and license files
# for the code accessed (or partly included) from contributed R-ports
# and other sources
# see Rmetrics's copyright file
################################################################################
# FUNCTION: LOOKBACK OPTIONS:
# FloatingStrikeLookbackOption Floating Strike Lookback Option
# FixedStrikeLookbackOption Fixed Strike Lookback Option
# PTFloatingStrikeLookbackOption Partial Floating Strike LB Option
# PTFixedStrikeLookbackOption Partial Fixed Strike LB Option
# ExtremeSpreadOption Extreme Spread Option
################################################################################
test.FloatingStrikeLookbackOption =
function()
{
# Examples from Chapter 2.9 in E.G. Haug's Option Guide (1997)
# Floating Strike Lookback Option [2.9.1]:
FloatingStrikeLookbackOption(TypeFlag = "c", S = 120,
SMinOrMax = 100, Time = 0.5, r = 0.10, b = 0.10-0.06,
sigma = 0.30)
# Return Value:
return()
}
# ------------------------------------------------------------------------------
test.FixedStrikeLookbackOption =
function()
{
# Fixed Strike Lookback Option [2.9.2]:
FixedStrikeLookbackOption(TypeFlag = "c", S = 100,
SMinOrMax = 100, X = 105, Time = 0.5, r = 0.10, b = 0.10,
sigma = 0.30)
# Return Value:
return()
}
# ------------------------------------------------------------------------------
test.PTFloatingStrikeLookbackOption =
function()
{
# Partial Time Floating Strike Lookback Option [2.9.3]:
PTFloatingStrikeLookbackOption(TypeFlag = "p", S = 90,
SMinOrMax = 90, time1 = 0.5, Time2 = 1, r = 0.06, b = 0.06,
sigma = 0.20, lambda = 1)
# Return Value:
return()
}
# ------------------------------------------------------------------------------
test.PTFixedStrikeLookbackOption =
function()
{
# Partial Time Fixed Strike Lookback Option [2.9.4]:
PTFixedStrikeLookbackOption(TypeFlag = "c", S = 100, X = 90,
time1 = 0.5, Time2 = 1, r = 0.06, b = 0.06, sigma = 0.20)
# Return Value:
return()
}
# ------------------------------------------------------------------------------
test.ExtremeSpreadOption =
function()
{
# Extreme Spread Option [2.9.5]:
ExtremeSpreadOption(TypeFlag = "c", S = 100, SMin = NA,
SMax = 110, time1 = 0.5, Time2 = 1, r = 0.1, b = 0.1,
sigma = 0.30)
ExtremeSpreadOption(TypeFlag = "cr", S = 100, SMin = 90,
SMax = NA, time1 = 0.5, Time2 = 1, r = 0.1, b = 0.1,
sigma = 0.30)
# Return Value:
return()
}
################################################################################
fExoticOptions/tests/ 0000755 0001762 0000144 00000000000 13203477730 014377 5 ustar ligges users fExoticOptions/tests/doRUnit.R 0000644 0001762 0000144 00000001520 11645005266 016103 0 ustar ligges users #### doRUnit.R --- Run RUnit tests
####------------------------------------------------------------------------
### Origianlly follows Gregor Gojanc's example in CRAN package 'gdata'
### and the corresponding section in the R Wiki:
### http://wiki.r-project.org/rwiki/doku.php?id=developers:runit
### MM: Vastly changed: This should also be "runnable" for *installed*
## package which has no ./tests/
## ----> put the bulk of the code e.g. in ../inst/unitTests/runTests.R :
if(require("RUnit", quietly = TRUE)) {
## --- Setup ---
wd <- getwd()
pkg <- sub("\\.Rcheck$", '', basename(dirname(wd)))
library(package = pkg, character.only = TRUE)
path <- system.file("unitTests", package = pkg)
stopifnot(file.exists(path), file.info(path.expand(path))$isdir)
source(file.path(path, "runTests.R"), echo = TRUE)
}
fExoticOptions/NAMESPACE 0000644 0001762 0000144 00000001302 13202327341 014437 0 ustar ligges users
################################################
## fExoticOptions
################################################
################################################
## import name space
################################################
import("timeDate")
import("timeSeries")
import("fBasics")
import("fOptions")
importFrom("methods", new)
################################################
## S4 classes
################################################
################################################
## S3 classes
################################################
################################################
## functions
################################################
exportPattern(".")
fExoticOptions/R/ 0000755 0001762 0000144 00000000000 13203477730 013436 5 ustar ligges users fExoticOptions/R/MultipleAssetsOptions.R 0000644 0001762 0000144 00000036714 12323220016 020107 0 ustar ligges users
# This library is free software; you can redistribute it and/or
# modify it under the terms of the GNU Library General Public
# License as published by the Free Software Foundation; either
# version 2 of the License, or (at your option) any later version.
#
# This library is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU Library General Public License for more details.
#
# You should have received a copy of the GNU Library General
# Public License along with this library; if not, write to the
# Free Foundation, Inc., 59 Temple Place, Suite 330, Boston,
# MA 02111-1307 USA
################################################################################
# FUNCTION: DESCRIPTION:
# Multiple Asset Options:
# TwoAssetCorrelationOption Two Asset Correlation Option
# [ExchangeOneForAnotherOption] [Exchange One For Another Option]
# EuropeanExchangeOption European Exchange Optionn
# AmericanExchangeOption American Exchange Option
# ExchangeOnExchangeOption Exchange Exchange Option
# TwoRiskyAssetsOption Option On The MinMax
# SpreadApproxOption Spread Approximated Option
################################################################################
TwoAssetCorrelationOption =
function(TypeFlag = c("c", "p"), S1, S2, X1, X2, Time, r, b1, b2,
sigma1, sigma2, rho, title = NULL, description = NULL)
{ # A function implemented by Diethelm Wuertz
# Description:
# Two asset correlation options
# References:
# Haug, Chapter 2.8.1
# FUNCTION:
# Compute Settings:
TypeFlag = TypeFlag[1]
y1 = (log(S1/X1) + (b1 - sigma1^2 / 2) * Time) / (sigma1*sqrt(Time))
y2 = (log(S2/X2) + (b2 - sigma2^2 / 2) * Time) / (sigma2*sqrt(Time))
# Calculate Call and Put:
if (TypeFlag == "c")
TwoAssetCorrelation = (S2 * exp ((b2 - r) * Time) * CBND(y2 +
sigma2 * sqrt(Time), y1 + rho * sigma2
* sqrt(Time), rho) - X2 * exp (-r *
Time) * CBND(y2, y1, rho))
if (TypeFlag == "p")
TwoAssetCorrelation = (X2 * exp (-r * Time) * CBND(-y2, -y1,
rho) - S2 * exp ((b2 - r) * Time) *
CBND(-y2 - sigma2 * sqrt(Time), -y1 -
rho * sigma2 * sqrt(Time), rho))
# Parameters:
# TypeFlag = c("c", "p"), S1, S2, X1, X2, Time, r, b1, b2, sigma1,
# sigma2, rho
param = list()
param$TypeFlag = TypeFlag
param$S1 = S1
param$S2 = S2
param$X1 = X1
param$X2 = X2
param$Time = Time
param$r = r
param$b1 = b1
param$b2 = b2
param$sigma1 = sigma1
param$sigma2 = sigma2
param$rho = rho
# Add title and description:
if (is.null(title)) title = "Two Asset Correlation Option"
if (is.null(description)) description = as.character(date())
# Return Value:
new("fOPTION",
call = match.call(),
parameters = param,
price = TwoAssetCorrelation,
title = title,
description = description
)
}
# ------------------------------------------------------------------------------
EuropeanExchangeOption =
function(S1, S2, Q1, Q2, Time, r, b1, b2, sigma1, sigma2, rho,
title = NULL, description = NULL)
{ # A function implemented by Diethelm Wuertz
# Description:
# Exchange-One-Asset-for-Another-Asset options -
# European option to exchange one asset for another
# References:
# Haug, Chapter 2.8.2 (European)
# FUNCTION:
# Compute Settings:
sigma = sqrt (sigma1 ^ 2 + sigma2 ^ 2 - 2 * rho * sigma1 * sigma2)
d1 = ((log(Q1*S1/(Q2 * S2)) + (b1-b2+sigma^2/2)*Time)/(sigma*sqrt(Time)))
d2 = d1 - sigma * sqrt (Time)
# calculate Price:
EuropeanExchange = (Q1 * S1 * exp ((b1 - r) * Time) * CND(d1) -
Q2 * S2 * exp((b2 - r) * Time) * CND(d2))
# Parameters:
# S1, S2, Q1, Q2, Time, r, b1, b2, sigma1, sigma2, rho
param = list()
param$S1 = S1
param$S2 = S2
param$Q1 = Q1
param$Q2 = Q2
param$Time = Time
param$r = r
param$b1 = b1
param$b2 = b2
param$sigma1 = sigma1
param$sigma2 = sigma2
param$rho = rho
# Add title and description:
if (is.null(title)) title = "European Exchange Option"
if (is.null(description)) description = as.character(date())
# Return Value:
new("fOPTION",
call = match.call(),
parameters = param,
price = EuropeanExchange,
title = title,
description = description
)
}
# ------------------------------------------------------------------------------
AmericanExchangeOption =
function(S1, S2, Q1, Q2, Time, r, b1, b2, sigma1, sigma2, rho,
title = NULL, description = NULL)
{ # A function implemented by Diethelm Wuertz
# Description:
# Exchange-One-Asset-for-Another-Asset options -
# American option to exchange one asset for another
# References:
# Haug, Chapter 2.8.2 (American)
# FUNCTION:
# Compute Settings:
sigma = sqrt(sigma1^2 + sigma2^2 - 2 * rho * sigma1 * sigma2)
# Calculate Price:
AmericanExchange = BSAmericanApproxOption("c", Q1*S1, Q2*S2,
Time, r-b2, b1-b2, sigma)
# Parameters:
# S1, S2, Q1, Q2, Time, r, b1, b2, sigma1, sigma2, rho
param = list()
param$S1 = S1
param$s2 = S2
param$Q1 = Q2
param$Time = Time
param$r = r
param$b1 = b1
param$b2 = b2
param$sigma1 = sigma1
param$sigma2 = sigma2
param$rho = rho
param$TriggerPrice = AmericanExchange@parameters$TriggerPrice
# Add title and description:
if (is.null(title)) title = "American Exchange Option"
if (is.null(description)) description = as.character(date())
# Return Value:
new("fOPTION",
call = match.call(),
parameters = param,
price = AmericanExchange@price,
title = title,
description = description
)
}
# ------------------------------------------------------------------------------
ExchangeOnExchangeOption =
function(TypeFlag = c("1", "2", "3", "4"), S1, S2, Q, time1, Time2, r,
b1, b2, sigma1, sigma2, rho, title = NULL, description = NULL)
{ # A function implemented by Diethelm Wuertz
# Description:
# Exchange-One-Asset-for-Another-Asset options -
# References:
# Haug, Chapter 2.8.3
# FUNCTION:
# Define Functions:
TypeFlag = TypeFlag[1]
q = Q
# Compute:
v = sqrt(sigma1 ^ 2 + sigma2 ^ 2 - 2 * rho * sigma1 * sigma2)
I1 = S1 * exp((b1 - r) * (Time2 - time1)) /
(S2 * exp((b2 - r) * (Time2 - time1)))
if (TypeFlag == "1" || TypeFlag == "2") {
id = 1 }
else {
id = 2 }
I = .EOnEOption.CriticalPrice(id, I1, time1, Time2, v, q)
d1 = (log(S1 / (I * S2)) + (b1 - b2 + v ^ 2 / 2) * time1) / (v * sqrt(time1))
d2 = d1 - v * sqrt(time1)
d3 = (log((I * S2) / S1) + (b2 - b1 + v ^ 2 / 2) * time1) / (v * sqrt(time1))
d4 = d3 - v * sqrt(time1)
y1 = (log(S1 / S2) + (b1 - b2 + v ^ 2 / 2) * Time2) / (v * sqrt(Time2))
y2 = y1 - v * sqrt(Time2)
y3 = (log(S2 / S1) + (b2 - b1 + v ^ 2 / 2) * Time2) / (v * sqrt(Time2))
y4 = y3 - v * sqrt(Time2)
# Calculate Price:
if (TypeFlag == "1")
ExchangeOnExchange = (-S2 * exp((b2 - r) * Time2) * CBND(d2,
y2, sqrt(time1/Time2)) + S1 * exp((b1-r)
* Time2) * CBND(d1, y1,
sqrt(time1/Time2)) - q * S2 * exp((b2-r)
* time1) * CND(d2))
if (TypeFlag == "2")
ExchangeOnExchange = (S2 * exp((b2 - r) * Time2) * CBND(d3,
y2, -sqrt(time1/Time2)) - S1 *
exp((b1-r) * Time2) * CBND(d4, y1,
-sqrt(time1/Time2)) + q * S2 * exp((b2 -
r) * time1) * CND(d3))
if (TypeFlag == "3")
ExchangeOnExchange = (S2 * exp((b2 - r) * Time2) * CBND(d3,
y3, sqrt(time1/Time2)) - S1 * exp((b1-r)
* Time2) * CBND(d4, y4,
sqrt(time1/Time2)) - q * S2 * exp((b2-r)
* time1) * CND(d3))
if (TypeFlag == "4")
ExchangeOnExchange = (-S2 * exp((b2 - r) * Time2) * CBND(d2,
y3, -sqrt(time1/Time2)) + S1 *
exp((b1-r) * Time2) * CBND(d1, y4,
-sqrt(time1/Time2)) + q * S2 *
exp((b2-r) * time1) * CND(d2))
# Parameters:
# TypeFlag = c("1", "2", "3", "4"), S1, S2, Q, time1, Time2, r,
# b1, b2, sigma1, sigma2, rho
param = list()
param$TypeFlag = TypeFlag
param$S1 = S1
param$S2 = S2
param$Q = Q
param$time1 = time1
param$Time2 = Time2
param$r = r
param$b1 = b1
param$b2 = b2
param$sigma1 = sigma1
param$sigma2 = sigma2
param$rho = rho
# Add title and description:
if (is.null(title)) title = "Exchange On Exchange Option"
if (is.null(description)) description = as.character(date())
# Return Value:
new("fOPTION",
call = match.call(),
parameters = param,
price = ExchangeOnExchange,
title = title,
description = description
)
}
.EOnEOption.CriticalPart3 <-
function(id, I, time1, Time2, v)
{
if (id == 1) {
z1 = (log(I)+v^2/2*(Time2 - time1))/(v*sqrt(Time2-time1))
z2 = (log(I)-v^2/2*(Time2 - time1))/(v*sqrt(Time2-time1))
.EOnEOption.CriticalPart3 = I * CND(z1) - CND(z2) }
if (id == 2) {
z1 = (-log(I)+v^2/2*(Time2-time1))/(v*sqrt(Time2-time1))
z2 = (-log(I)-v^2/2*(Time2-time1))/(v*sqrt(Time2-time1))
.EOnEOption.CriticalPart3 = CND(z1) - I * CND(z2) }
.EOnEOption.CriticalPart3
}
.EOnEOption.CriticalPart2 <-
function(id, I, time1, Time2, v)
{
if (id == 1) {
z1 = (log(I)+v^2/2*(Time2-time1))/(v*sqrt(Time2-time1))
.EOnEOption.CriticalPart2 = CND(z1) }
if (id == 2) {
z2 = (-log(I)-v^2/2*(Time2-time1))/(v*sqrt(Time2-time1))
.EOnEOption.CriticalPart2 = -CND(z2) }
.EOnEOption.CriticalPart2
}
.EOnEOption.CriticalPrice =
function(id, I1, time1, Time2, v, q)
{
# Numerical search algorithm to find critical price I
Ii = I1
yi = .EOnEOption.CriticalPart3(id, Ii, time1, Time2, v)
# cat("\n.EOnEOption.CriticalPart3: ", yi)
di = .EOnEOption.CriticalPart2(id, Ii, time1, Time2, v)
# cat("\n.EOnEOption.CriticalPart2: ", di)
epsilon = 0.00001
while (abs(yi - q) > epsilon) {
Ii = Ii - (yi - q) / di
yi = .EOnEOption.CriticalPart3(id, Ii, time1, Time2, v)
# cat("\n.EOnEOption.CriticalPart3: ", yi)
di = .EOnEOption.CriticalPart2(id, Ii, time1, Time2, v)
# cat("\n.EOnEOption.CriticalPart2: ", di)
}
.EOnEOption.CriticalPrice = Ii
.EOnEOption.CriticalPrice
}
# ------------------------------------------------------------------------------
TwoRiskyAssetsOption =
function(TypeFlag = c("cmin", "cmax", "pmin", "pmax"), S1, S2, X, Time,
r, b1, b2, sigma1, sigma2, rho, title = NULL, description = NULL)
{ # A function implemented by Diethelm Wuertz
# Description:
# Option on two risky assets
# References:
# Haug, Chapter 2.8.4
# FUNCTION:
# Compute Settings:
TypeFlag = TypeFlag[1]
v = sqrt(sigma1 ^ 2 + sigma2 ^ 2 - 2 * rho * sigma1 * sigma2)
rho1 = (sigma1 - rho * sigma2) / v
rho2 = (sigma2 - rho * sigma1) / v
d = (log(S1 / S2) + (b1 - b2 + v ^ 2 / 2) * Time) / (v * sqrt(Time))
y1 = (log(S1 / X) + (b1 + sigma1 ^ 2 / 2) * Time) / (sigma1 * sqrt(Time))
y2 = (log(S2 / X) + (b2 + sigma2 ^ 2 / 2) * Time) / (sigma2 * sqrt(Time))
# Calculate Price:
OnTheMaxMin = NA
if (TypeFlag == "cmin")
OnTheMaxMin = (S1 * exp((b1 - r) * Time) * CBND(y1, -d, -rho1)
+ S2 * exp((b2 - r) * Time) * CBND(y2, d - v *
sqrt(Time), -rho2) - X * exp(-r * Time) *
CBND(y1 - sigma1 * sqrt(Time), y2 - sigma2 *
sqrt(Time), rho))
if (TypeFlag == "cmax")
OnTheMaxMin = (S1 * exp((b1 - r) * Time) * CBND(y1, d, rho1) +
S2 * exp((b2 - r) * Time) * CBND(y2, -d + v *
sqrt(Time), rho2) - X * exp(-r * Time) * (1 -
CBND(-y1 + sigma1*sqrt(Time), -y2 + sigma2 *
sqrt(Time), rho)))
if (TypeFlag == "pmin")
OnTheMaxMin = (X * exp(-r * Time) - S1 * exp((b1 - r) * Time)
+ EuropeanExchangeOption(S1, S2, 1, 1, Time, r,
b1, b2, sigma1, sigma2, rho)@price +
TwoRiskyAssetsOption("cmin", S1, S2, X, Time,
r, b1, b2, sigma1, sigma2, rho)@price)
if (TypeFlag == "pmax")
OnTheMaxMin = (X * exp(-r * Time) - S2 * exp((b2 - r) * Time)
- EuropeanExchangeOption(S1, S2, 1, 1, Time, r,
b1, b2, sigma1, sigma2, rho)@price +
TwoRiskyAssetsOption("cmax", S1, S2, X, Time,
r, b1, b2, sigma1, sigma2, rho)@price)
# Parameters:
# TypeFlag = c("cmin", "cmax", "pmin", "pmax"), S1, S2, X, Time, r,
# b1, b2, sigma1, sigma2, rho
param = list()
param$TypeFlag = TypeFlag
param$S1 = S1
param$S2 = S2
param$X = X
param$Time = Time
param$r = r
param$b1 = b1
param$b2 = b2
param$sigma1 = sigma1
param$sigma2 = sigma2
param$rho = rho
# Add title and description:
if (is.null(title)) title = "Two Risky Assets Option"
if (is.null(description)) description = as.character(date())
# Return Value:
new("fOPTION",
call = match.call(),
parameters = param,
price = OnTheMaxMin,
title = title,
description = description
)
}
# ------------------------------------------------------------------------------
SpreadApproxOption =
function(TypeFlag = c("c", "p"), S1, S2, X, Time, r, sigma1, sigma2, rho,
title = NULL, description = NULL)
{ # A function implemented by Diethelm Wuertz
# Description:
# Spread Option Approximation
# References:
# Haug, Chapter 2.8.5
# FUNCTION:
# Compute Settings:
TypeFlag = TypeFlag[1]
F1 = S1
F2 = S2
sigma = sqrt(sigma1 ^ 2 + (sigma2 * F2 / (F2 + X)) ^ 2 - 2 * rho *
sigma1 * sigma2 * F2 / (F2 + X))
FF = F1 / (F2 + X)
# Calculate Price
SpreadApproximation <- (GBSOption(TypeFlag, FF, 1, Time, r, 0, sigma)@price *
(F2 + X) * exp(-r * Time))
# Parameters:
# TypeFlag = c("c", "p"), S1, S2, X, Time, r, sigma1, sigma2, rho
param = list()
param$TypeFlag = TypeFlag
param$S1 = S1
param$S2 = S2
param$X = X
param$Time = Time
param$r = r
param$sigma1 = sigma1
param$sigma2 = sigma2
param$rho = rho
# Add title and description:
if (is.null(title)) title = "Spread Approx Option"
if (is.null(description)) description = as.character(date())
# Return Value:
new("fOPTION",
call = match.call(),
parameters = param,
price = SpreadApproximation,
title = title,
description = description
)
}
################################################################################
fExoticOptions/R/BinaryOptions.R 0000644 0001762 0000144 00000033530 12323220016 016346 0 ustar ligges users
# This library is free software; you can redistribute it and/or
# modify it under the terms of the GNU Library General Public
# License as published by the Free Software Foundation; either
# version 2 of the License, or (at your option) any later version.
#
# This library is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU Library General Public License for more details.
#
# You should have received a copy of the GNU Library General
# Public License along with this library; if not, write to the
# Free Foundation, Inc., 59 Temple Place, Suite 330, Boston,
# MA 02111-1307 USA
################################################################################
# FUNCTION: DESCRIPTION:
# Binary Options:
# GapOption Gap Option
# CashOrNothingOption Cash Or Nothing Option
# TwoAssetCashOrNothingOption Two Asset Cash-Or Nothing Option
# AssetOrNothingOption Asset Or Nothing Option
# SuperShareOption Super Share Option
# BinaryBarrierOption Binary Barrier Option
################################################################################
GapOption =
function(TypeFlag = c("c", "p"), S, X1, X2, Time, r, b, sigma,
title = NULL, description = NULL)
{ # A function imlemented by Diethelm Wuertz
# Description:
# Gap Options
# References:
# Haug, Haug Chapter 2.11.1
# FUNCTION:
# Compute Price:
TypeFlag = TypeFlag[1]
d1 = (log(S/X1) + (b + sigma^2 / 2) * Time) / (sigma * sqrt(Time))
d2 = d1 - sigma*sqrt (Time)
if (TypeFlag == "c")
GapOption = S*exp((b-r)*Time)*CND(d1) - X2*exp(-r*Time)*CND(d2)
if (TypeFlag == "p")
GapOption = X2*exp(-r*Time)*CND(-d2) - S*exp((b-r)*Time)*CND(-d1)
# Parameters:
# TypeFlag = c("c", "p"), S, X1, X2, Time, r, b, sigma
param = list()
param$TypeFlag = TypeFlag
param$S = S
param$X1 = X1
param$X2 = X2
param$Time = Time
param$r = r
param$b = b
param$sigma = sigma
# Add title and description:
if (is.null(title)) title = "Gap Option"
if (is.null(description)) description = as.character(date())
# Return Value:
new("fOPTION",
call = match.call(),
parameters = param,
price = GapOption,
title = title,
description = description
)
}
# ------------------------------------------------------------------------------
CashOrNothingOption =
function(TypeFlag = c("c", "p"), S, X, K, Time, r, b, sigma,
title = NULL, description = NULL)
{ # A function imlemented by Diethelm Wuertz
# Description:
# Cash-Or-Nothing Options
# References:
# Haug, Chapter 2.11.2
# FUNCTION:
# Compute Price:
TypeFlag = TypeFlag[1]
d = (log(S / X) + (r + b - sigma ^ 2 / 2) * Time) / (sigma * sqrt(Time))
if (TypeFlag == "c")
CashOrNothing = K * exp (-r * Time) * CND(d)
if (TypeFlag == "p")
CashOrNothing = K * exp (-r * Time) * CND(-d)
# Parameters:
# TypeFlag = c("c", "p"), S, X, K, Time, r, b, sigma
param = list()
param$TypeFlag = TypeFlag
param$S = S
param$X = X
param$K = K
param$Time = Time
param$r = r
param$b = b
param$sigma = sigma
# Add title and description:
if (is.null(title)) title = "Cash Or Nothing Option"
if (is.null(description)) description = as.character(date())
# Return Value:
new("fOPTION",
call = match.call(),
parameters = param,
price = CashOrNothing,
title = title,
description = description
)
}
# ------------------------------------------------------------------------------
TwoAssetCashOrNothingOption =
function(TypeFlag = c("c", "p", "ud", "du"), S1, S2, X1, X2, K, Time, r,
b1, b2, sigma1, sigma2, rho, title = NULL, description = NULL)
{ # A function imlemented by Diethelm Wuertz
# Description:
# Two Asset Cash-Or-Nothing Options
# References:
# Haug, Chapter 2.11.3
# Arguments:
# 1: Asset One, 2: Asset Two
# TypeFlag
# 1 Call
# 2 Put
# 3 Up-Down
# 4 Down-Up
# S=c(S1,S2) Asset Prices
# K Payout
# X=c(X1,X2) Strikes
# b=c(b1,b2) Cost-of-Carry
# sigma=c(sigma1,sigma2) Volatilities
# rho Correlation
#
# FUNCTION:
# Compute Price:
TypeFlag = TypeFlag[1]
d11 = ((log(S1/X1) + (b1 - sigma1^2/2) * Time) /
(sigma1*sqrt(Time)))
d22 = ((log(S2/X2) + (b2 - sigma2^2/2) * Time) /
(sigma2*sqrt(Time)))
# Select:
if (TypeFlag == "c")
TwoAssetCashOrNothing = K * exp (-r * Time) * CBND( d11, d22, rho)
if (TypeFlag == "p")
TwoAssetCashOrNothing = K * exp (-r * Time) * CBND(-d11, -d22, rho)
if (TypeFlag == "ud")
TwoAssetCashOrNothing = K * exp (-r * Time) * CBND( d11, -d22, -rho)
if (TypeFlag == "du")
TwoAssetCashOrNothing = K * exp (-r * Time) * CBND(-d11, d22, -rho)
# Parameters:
# TypeFlag = c("c", "p", "ud", "du"), S1, S2, X1, X2, K, Time, r,
# b1, b2, sigma1, sigma2, rho
param = list()
param$TypeFlag = TypeFlag
param$S1 = S1
param$S2 = S2
param$X1 = X1
param$X2 = X2
param$K = K
param$Time = Time
param$r = r
param$b1 = b1
param$b2 = b2
param$sigma1 = sigma1
param$sigma2 = sigma2
param$rho = rho
# Add title and description:
if (is.null(title)) title = "Two Asset Cash Or Nothing Option"
if (is.null(description)) description = as.character(date())
# Return Value:
new("fOPTION",
call = match.call(),
parameters = param,
price = TwoAssetCashOrNothing,
title = title,
description = description
)
}
# ------------------------------------------------------------------------------
AssetOrNothingOption =
function(TypeFlag = c("c", "p"), S, X, Time, r, b, sigma,
title = NULL, description = NULL)
{ # A function imlemented by Diethelm Wuertz
# Description:
# Asset-or-Nothing Options
# Reference:
# Cox Rubinstein (1985)
# Haug, Chapter 2.11.4
# FUNCTION:
# Compute Price:
TypeFlag = TypeFlag[1]
d = (log(S/X) + (b + sigma^2 / 2) * Time) / (sigma * sqrt(Time))
if (TypeFlag == "c")
AssetOrNothing = S * exp ((b - r) * Time) * CND( d)
if (TypeFlag == "p")
AssetOrNothing = S * exp ((b - r) * Time) * CND(-d)
# Parameters:
# # TypeFlag = c("c", "p"), S, X, Time, r, b, sigma
param = list()
param$TypeFlag = TypeFlag
param$S = S
param$X = X
param$Time = Time
param$r = r
param$b = b
param$sigma = sigma
# Add title and description:
if (is.null(title)) title = "Asset Or Nothing Option"
if (is.null(description)) description = as.character(date())
# Return Value:
new("fOPTION",
call = match.call(),
parameters = param,
price = AssetOrNothing,
title = title,
description = description
)
}
# ------------------------------------------------------------------------------
SuperShareOption =
function(S, XL, XH, Time, r, b, sigma, title = NULL, description = NULL)
{ # A function imlemented by Diethelm Wuertz
# Description:
# Supershare Options
# Reference:
# Hakansson (1976)
# Haug, Chapter 2.11.5
# FUNCTION:
# Compute Price:
d1 = (log(S/XL) + (b + sigma^2 / 2) * Time) / (sigma * sqrt(Time))
d2 = (log(S/XH) + (b + sigma^2 / 2) * Time) / (sigma * sqrt(Time))
SuperShare = (S * exp((b-r)*Time) / XL) * (CND(d1) - CND(d2))
# Parameters:
# S, XL, XH, Time, r, b, sigma
param = list()
param$S = S
param$XL = XL
param$XH = XH
param$Time = Time
param$r = r
param$b = b
param$sigma = sigma
# Add title and description:
if (is.null(title)) title = "Super Share Option"
if (is.null(description)) description = as.character(date())
# Return Value:
new("fOPTION",
call = match.call(),
parameters = param,
price = SuperShare,
title = title,
description = description
)
}
# ------------------------------------------------------------------------------
BinaryBarrierOption =
function(TypeFlag = as.character(1:28), S, X, H, K, Time, r, b, sigma,
eta, phi, title = NULL, description = NULL)
{ # A function imlemented by Diethelm Wuertz
# Description:
# Binary Barrier Options
# Reference:
# Reiner and Rubinstein (1991)
# Haug, Chapter 2.11.6
# FUNCTION:
# Compute Price:
TypeFlag = as.integer(TypeFlag[1])
eta = rep(c(+1,-1), 14)[TypeFlag]
# 1 2 3 4 5 6 7 8 9 10 11 12 13 14
# 15 16 17 18 19 20 21 22 23 24 25 26 27 28
phi = c(+0,+0,+0,+0,-1,+1,-1,+1,+1,-1,+1,-1,+1,+1,
+1,+1,-1,-1,-1,-1,+1,+1,+1,+1,-1,-1,-1,-1)[TypeFlag]
v = sigma
mu = (b - v ^ 2 / 2) / v ^ 2
lambda = sqrt(mu ^ 2 + 2 * r / v ^ 2)
X1 = log(S / X) / (v * sqrt(Time)) + (mu + 1) * v * sqrt(Time)
X2 = log(S / H) / (v * sqrt(Time)) + (mu + 1) * v * sqrt(Time)
y1 = log(H ^ 2 / (S * X)) / (v * sqrt(Time)) + (mu + 1) * v * sqrt(Time)
y2 = log(H / S) / (v * sqrt(Time)) + (mu + 1) * v * sqrt(Time)
Z = log(H / S) / (v * sqrt(Time)) + lambda * v * sqrt(Time)
# Values:
a1 = S * exp((b - r) * Time) * CND(phi * X1)
b1 = K * exp(-r * Time) * CND(phi * X1 - phi * v * sqrt(Time))
a2 = S * exp((b - r) * Time) * CND(phi * X2)
b2 = K * exp(-r * Time) * CND(phi * X2 - phi * v * sqrt(Time))
a3 = (S * exp((b - r) * Time) * (H / S) ^ (2 * (mu + 1)) *
CND(eta * y1))
b3 = (K * exp(-r * Time) * (H / S) ^ (2 * mu) *
CND(eta * y1 - eta * v * sqrt(Time)))
a4 = (S * exp((b - r) * Time) * (H / S) ^ (2 * (mu + 1)) *
CND(eta * y2))
b4 = (K * exp(-r * Time) * (H / S) ^ (2 * mu) *
CND(eta * y2 - eta * v * sqrt(Time)))
a5 = (K * ((H / S) ^ (mu + lambda) *
CND(eta * Z) + (H / S) ^ (mu - lambda) *
CND(eta * Z - 2 * eta * lambda * v * sqrt(Time))))
# Select:
BinaryBarrier = NA
if (X > H) {
if (TypeFlag == 1) BinaryBarrier = a5
if (TypeFlag == 2) BinaryBarrier = a5
if (TypeFlag == 3) BinaryBarrier = a5
if (TypeFlag == 4) BinaryBarrier = a5
if (TypeFlag == 5) BinaryBarrier = b2 + b4
if (TypeFlag == 6) BinaryBarrier = b2 + b4
if (TypeFlag == 7) BinaryBarrier = a2 + a4
if (TypeFlag == 8) BinaryBarrier = a2 + a4
if (TypeFlag == 9) BinaryBarrier = b2 - b4
if (TypeFlag == 10) BinaryBarrier = b2 - b4
if (TypeFlag == 11) BinaryBarrier = a2 - a4
if (TypeFlag == 12) BinaryBarrier = a2 - a4
if (TypeFlag == 13) BinaryBarrier = b3
if (TypeFlag == 14) BinaryBarrier = b3
if (TypeFlag == 15) BinaryBarrier = a3
if (TypeFlag == 16) BinaryBarrier = a1
if (TypeFlag == 17) BinaryBarrier = b2 - b3 + b4
if (TypeFlag == 18) BinaryBarrier = b1 - b2 + b4
if (TypeFlag == 19) BinaryBarrier = a2 - a3 + a4
if (TypeFlag == 20) BinaryBarrier = a1 - a2 + a3
if (TypeFlag == 21) BinaryBarrier = b1 - b3
if (TypeFlag == 22) BinaryBarrier = 0
if (TypeFlag == 23) BinaryBarrier = a1 - a3
if (TypeFlag == 24) BinaryBarrier = 0
if (TypeFlag == 25) BinaryBarrier = b1 - b2 + b3 - b4
if (TypeFlag == 26) BinaryBarrier = b2 - b4
if (TypeFlag == 27) BinaryBarrier = a1 - a2 + a3 - a4
if (TypeFlag == 28) BinaryBarrier = a2 - a4 }
# Continue:
if (X < H) {
if (TypeFlag == 1) BinaryBarrier = a5
if (TypeFlag == 2) BinaryBarrier = a5
if (TypeFlag == 3) BinaryBarrier = a5
if (TypeFlag == 4) BinaryBarrier = a5
if (TypeFlag == 5) BinaryBarrier = b2 + b4
if (TypeFlag == 6) BinaryBarrier = b2 + b4
if (TypeFlag == 7) BinaryBarrier = a2 + a4
if (TypeFlag == 8) BinaryBarrier = a2 + a4
if (TypeFlag == 9) BinaryBarrier = b2 - b4
if (TypeFlag == 10) BinaryBarrier = b2 - b4
if (TypeFlag == 11) BinaryBarrier = a2 - a4
if (TypeFlag == 12) BinaryBarrier = a2 - a4
if (TypeFlag == 13) BinaryBarrier = b1 - b2 + b4
if (TypeFlag == 14) BinaryBarrier = b2 - b3 + b4
if (TypeFlag == 15) BinaryBarrier = a1 - a2 + a4
if (TypeFlag == 16) BinaryBarrier = a2 - a3 + a4
if (TypeFlag == 17) BinaryBarrier = b1
if (TypeFlag == 18) BinaryBarrier = b3
if (TypeFlag == 19) BinaryBarrier = a1
if (TypeFlag == 20) BinaryBarrier = a3
if (TypeFlag == 21) BinaryBarrier = b2 - b4
if (TypeFlag == 22) BinaryBarrier = b1 - b2 + b3 - b4
if (TypeFlag == 23) BinaryBarrier = a2 - a4
if (TypeFlag == 24) BinaryBarrier = a1 - a2 + a3 - a4
if (TypeFlag == 25) BinaryBarrier = 0
if (TypeFlag == 26) BinaryBarrier = b1 - b3
if (TypeFlag == 27) BinaryBarrier = 0
if (TypeFlag == 28) BinaryBarrier = a1 - a3 }
# Parameters:
# TypeFlag = as.character(1:28), S, X, H, K, Time, r, b, sigma, eta, phi
param = list()
param$TypeFlag = TypeFlag
param$S = S
param$X = X
param$H = H
param$K = K
param$Time = Time
param$r = r
param$b = b
param$sigma = sigma
param$eta = eta
param$phi = phi
# Add title and description:
if (is.null(title)) title = "Binary Barrier Option"
if (is.null(description)) description = as.character(date())
# Return Value:
new("fOPTION",
call = match.call(),
parameters = param,
price = BinaryBarrier,
title = title,
description = description
)
}
################################################################################
fExoticOptions/R/MultipleExercisesOptions.R 0000644 0001762 0000144 00000043173 12323220016 020574 0 ustar ligges users
# This library is free software; you can redistribute it and/or
# modify it under the terms of the GNU Library General Public
# License as published by the Free Software Foundation; either
# version 2 of the License, or (at your option) any later version.
#
# This library is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU Library General Public License for more details.
#
# You should have received a copy of the GNU Library General
# Public License along with this library; if not, write to the
# Free Foundation, Inc., 59 Temple Place, Suite 330, Boston,
# MA 02111-1307 USA
################################################################################
# FUNCTION: MULTIPLE EXERCISES OPTIONS:
# ExecutiveStockOption Executive Stock Option
# ForwardStartOption Forward Start Option
# RatchetOption Ratchet [Compound] Option
# TimeSwitchOption Time Switch Option
# SimpleChooserOption Simple Chooser Option
# ComplexChooserOption Complex Chooser Option
# OptionOnOption Options On Options
# HolderExtendibleOption Holder Extendible Option
# WriterExtendibleOption Writer Extendible Option
################################################################################
ExecutiveStockOption =
function(TypeFlag = c("c", "p"), S, X, Time, r, b, sigma, lambda,
title = NULL, description = NULL)
{ # A function implemented by Diethelm Wuertz
# Description:
# Executive stock options
# References:
# Jennergren and Naslund (1993)
# Haug, Chapter 2.1
# FUNCTION:
# Settings:
TypeFlag = TypeFlag[1]
# Calculate Price:
result = (exp (-lambda * Time) *
GBSOption(TypeFlag = TypeFlag, S = S, X = X,
Time = Time, r = r, b = b, sigma = sigma)@price)
# Parameters:
# TypeFlag = c("c", "p"), S, X, Time, r, b, sigma, lambda
param = list()
param$TypeFlag = TypeFlag
param$S = S
param$X = X
param$Time = Time
param$r = r
param$b = b
param$sigma = sigma
param$lambda = lambda
# Add title and description:
if (is.null(title)) title = "Executive Stock Option Valuation"
if (is.null(description)) description = as.character(date())
# Return Value:
new("fOPTION",
call = match.call(),
parameters = param,
price = result,
title = title,
description = description
)
}
# ------------------------------------------------------------------------------
ForwardStartOption =
function(TypeFlag = c("c", "p"), S, alpha, time1, Time2, r, b, sigma,
title = NULL, description = NULL)
{ # A function implemented by Diethelm Wuertz
# Description:
# Forward Start Options
# References:
# Rubinstein (1990)
# Haug, Chapter 2.2
# FUNCTION:
# Settings:
TypeFlag = TypeFlag[1]
# Compute Settings:
Time = time1
time = Time2
# Compute Price:
result = (S * exp ((b - r) * time ) *
GBSOption(TypeFlag, S = 1, X = alpha, Time = Time-time,
r = r, b = b, sigma = sigma)@price)
# Parameters:
# TypeFlag = c("c", "p"), S, alpha, time1, Time2, r, b, sigma
param = list()
param$TypeFlag = TypeFlag
param$S = S
param$alpha = alpha
param$time1 = time1
param$Time2 = Time2
param$r = r
param$b = b
param$sigma = sigma
# Add title and description:
if (is.null(title)) title = "Forward Start Option Valuation"
if (is.null(description)) description = as.character(date())
# Return Value:
new("fOPTION",
call = match.call(),
parameters = param,
price = result,
title = title,
description = description
)
}
# ------------------------------------------------------------------------------
RatchetOption =
function(TypeFlag = c("c", "p"), S, alpha, time1, Time2, r, b, sigma,
title = NULL, description = NULL)
{ # A function implemented by Diethelm Wuertz
# Description:
# Ratchet Option,
# other names are MovingStrikeOption or CliquetOption
# References:
# Haug, Chapter 2.3
# FUNCTION:
# Settings:
TypeFlag = TypeFlag[1]
# Calculate Price
result = 0
for ( i in 1:length(Time2) ) {
result = (result +
ForwardStartOption(TypeFlag = TypeFlag, S = S, alpha = alpha,
time1 = time1[i], Time2 = Time2[i],
r = r, b = b, sigma = sigma)@price) }
# Parameters:
# TypeFlag = c("c", "p"), S, alpha, time1, Time2, r, b, sigma
param = list()
param$TypeFlag = TypeFlag
param$S = S
param$alpha = alpha
param$time1 = time1
param$Time2 = Time2
param$r = r
param$b = b
param$sigma = sigma
# Add title and description:
if (is.null(title)) title = "Ratchet Option Valuation"
if (is.null(description)) description = as.character(date())
# Return Value:
new("fOPTION",
call = match.call(),
parameters = param,
price = result,
title = title,
description = description
)
}
# ------------------------------------------------------------------------------
TimeSwitchOption =
function(TypeFlag = c("c", "p"), S, X, Time, r, b, sigma, A, m, dt,
title = NULL, description = NULL)
{ # A function implemented by Diethelm Wuertz
# Description:
# Discrete time switch options
# References:
# Pechtl (1995)
# Haug, Chapter 2.4
# FUNCTION:
# Settings:
TypeFlag = TypeFlag[1]
# Compute Settings:
n = Time / dt
Sum = 0
if (TypeFlag == "c") Z = +1
if (TypeFlag == "p") Z = -1
# Calculate Price:
Sum = 0
for (I in (1:n)) {
d = (log(S/X) + (b - sigma^2/2) * I * dt) / (sigma * sqrt(I * dt))
Sum = Sum + CND (Z * d) * dt }
result = A * exp (-r * Time) * Sum + dt * A * exp(-r * Time) * m
# Parameters:
# TypeFlag = c("c", "p"), S, X, Time, r, b, sigma, A, m, dt
param = list()
param$TypeFlag = TypeFlag
param$S = S
param$X = X
param$Time = Time
param$r = r
param$b = b
param$sigma = sigma
param$A = A
param$m = m
param$d = dt
# Add title and description:
if (is.null(title)) title = "Time Switch Option Valuation"
if (is.null(description)) description = as.character(date())
# Return Value:
new("fOPTION",
call = match.call(),
parameters = param,
price = result,
title = title,
description = description
)
}
# ------------------------------------------------------------------------------
SimpleChooserOption =
function(S, X, time1, Time2, r, b, sigma,
title = NULL, description = NULL)
{ # A function implemented by Diethelm Wuertz
# Description:
# Simple Chooser Options
# References:
# Rubinstein (1991)
# Haug, Chapter 2.5.1
# FUNCTION:
# Compute Settings:
d = (log(S/X) + (b + sigma ^ 2 / 2) * Time2) / (sigma * sqrt(Time2))
y = ((log(S/X) + b * Time2 + sigma ^ 2 * time1 / 2) /
(sigma * sqrt(time1)))
# Calculate Price:
result = (S * exp ((b - r) * Time2) * CND(d) - X * exp(-r * Time2)
* CND(d - sigma * sqrt(Time2)) - S * exp ((b - r) *
Time2) * CND(-y) + X * exp(-r * Time2) * CND(-y + sigma
* sqrt(time1)))
# Parameters:
# S, X, time1, Time2, r, b, sigma
param = list()
param$S = S
param$X = X
param$time1 = time1
param$Time2 = Time2
param$r = r
param$b = b
param$sigma = sigma
# Add title and description:
if (is.null(title)) title = "Simple Chooser Option Valuation"
if (is.null(description)) description = as.character(date())
# Return Value:
new("fOPTION",
call = match.call(),
parameters = param,
price = result,
title = title,
description = description
)
}
# ------------------------------------------------------------------------------
ComplexChooserOption =
function(S, Xc, Xp, Time, Timec, Timep, r, b, sigma, doprint = FALSE,
title = NULL, description = NULL)
{ # A function implemented by Diethelm Wuertz
# Description:
# Complex Chooser Options
# References:
# Haug, Chapter 2.5.2
# FUNCTION:
# Compute Settings:
Tc = Timec
Tp = Timep
# Calculate Price:
CriticalValueChooser =
function(S, Xc, Xp, Time, Tc, Tp, r, b, sigma){
Sv = S
ci = GBSOption("c", Sv, Xc, Tc - Time, r, b, sigma)@price
Pi = GBSOption("p", Sv, Xp, Tp - Time, r, b, sigma)@price
dc = GBSGreeks("Delta", "c", Sv, Xc, Tc - Time, r, b, sigma)
dp = GBSGreeks("Delta", "p", Sv, Xp, Tp - Time, r, b, sigma)
yi = ci - Pi
di = dc - dp
epsilon = 0.001
# Newton-Raphson:
while (abs(yi) > epsilon) {
Sv = Sv - (yi) / di
ci = GBSOption("c", Sv, Xc, Tc - Time, r, b, sigma)@price
Pi = GBSOption("p", Sv, Xp, Tp - Time, r, b, sigma)@price
dc = GBSGreeks("Delta", "c", Sv, Xc, Tc - Time, r, b, sigma)
dp = GBSGreeks("Delta", "p", Sv, Xp, Tp - Time, r, b, sigma)
yi = ci - Pi
di = dc - dp }
result = Sv
result}
# Complex chooser options:
I = CriticalValueChooser (S, Xc, Xp, Time, Tc, Tp, r, b, sigma)
if (doprint) {
cat("\nCritical Value:\n")
print(I)
cat ("\n")}
d1 = (log(S / I) + (b + sigma ^ 2 / 2) * Time) / (sigma * sqrt(Time))
d2 = d1 - sigma * sqrt (Time)
y1 = (log(S / Xc) + (b + sigma ^ 2 / 2) * Tc) / (sigma * sqrt(Tc))
y2 = (log(S / Xp) + (b + sigma ^ 2 / 2) * Tp) / (sigma * sqrt(Tp))
rho1 = sqrt (Time / Tc)
rho2 = sqrt (Time / Tp)
result = (S * exp ((b - r) * Tc) * CBND(d1, y1, rho1) -
Xc * exp(-r * Tc) * CBND(d2, y1 - sigma * sqrt(Tc), rho1) -
S * exp((b - r) * Tp) * CBND(-d1, -y2, rho2) +
Xp * exp(-r * Tp) * CBND(-d2, -y2 + sigma * sqrt(Tp), rho2))
# Parameters:
# S, Xc, Xp, Time, Timec, Timep, r, b, sigma
param = list()
param$S = S
param$Xc = Xc
param$Xp = Xp
param$time = time
param$Timec = Timec
param$Timep = Timep
param$r = r
param$b = b
param$sigma = sigma
param$criticalValue = I
# Add title and description:
if (is.null(title)) title = "Complex Chooser Option Valuation"
if (is.null(description)) description = as.character(date())
# Return Value:
new("fOPTION",
call = match.call(),
parameters = param,
price = result,
title = title,
description = description
)
}
# ------------------------------------------------------------------------------
OptionOnOption =
function(TypeFlag = c("cc", "cp", "pc", "pp"), S, X1, X2, time1, Time2, r,
b, sigma, doprint = FALSE, title = NULL, description = NULL)
{ # A function implemented by Diethelm Wuertz
# Description:
# Option on Option
# References:
# Geske (1977), Geske (1979b), Hodges and Selby (1987),
# Rubinstein (1991a) et al.
# Haug, Chpater 2.6
# FUNCTION:
# Settings:
TypeFlag = TypeFlag[1]
# Compute Settings:
Time = time1
time = Time2
# Internal Function:
CriticalValueOptionOnOption =
function(TypeFlag, X1, X2, Time, r, b, sigma) {
# Calculation of critical price options on options
Si = X1
ci = GBSOption(TypeFlag, Si, X1, Time, r, b, sigma)@price
di = GBSGreeks("Delta", TypeFlag, Si, X1, Time, r, b, sigma)
epsilon = 0.000001
# Newton-Raphson algorithm:
while (abs(ci - X2) > epsilon) {
Si = Si - (ci - X2) / di
ci = GBSOption(TypeFlag, Si, X1, Time, r, b, sigma)@price
di = GBSGreeks("Delta", TypeFlag, Si, X1, Time, r, b, sigma) }
result = Si
result }
# Option On Option:
T2 = Time
t1 = time
TypeFlag2 = "p"
if (TypeFlag == "cc" || TypeFlag == "pc") TypeFlag2 = "c"
I = CriticalValueOptionOnOption(TypeFlag2, X1, X2, T2-t1, r, b, sigma)
if (doprint) { cat("\nCriticalValue: ", I, "\n") }
rho = sqrt (t1 / T2)
y1 = (log(S / I) + (b + sigma ^ 2 / 2) * t1) / (sigma * sqrt(t1))
y2 = y1 - sigma * sqrt (t1)
z1 = (log(S / X1) + (b + sigma ^ 2 / 2) * T2) / (sigma * sqrt(T2))
z2 = z1 - sigma * sqrt (T2)
if (TypeFlag == "cc")
result = (S * exp ((b - r) * T2) * CBND(z1, y1, rho) -
X1 * exp(-r * T2) * CBND(z2, y2, rho) - X2 * exp(-r * t1) *
CND(y2))
if (TypeFlag == "pc")
result = (X1 * exp (-r * T2) * CBND(z2, -y2, -rho) -
S * exp((b - r) * T2) * CBND(z1, -y1, -rho) + X2 *
exp(-r * t1) * CND(-y2))
if (TypeFlag == "cp")
result = (X1 * exp (-r * T2) * CBND(-z2, -y2, rho) -
S * exp((b - r) * T2) * CBND(-z1, -y1, rho) - X2 *
exp(-r * t1) * CND(-y2))
if (TypeFlag == "pp")
result = (S * exp ((b - r) * T2) * CBND(-z1, y1, -rho) -
X1 * exp(-r * T2) * CBND(-z2, y2, -rho) + exp(-r * t1) *
X2 * CND(y2))
# Parameters:
# TypeFlag = c("cc", "cp", "pc", "pp"), S, X1, X2, time1, Time2, r, b, sigma
param = list()
param$S = S
param$X1 = X1
param$X2 = X2
param$time1 = time1
param$Time2 = Time2
param$r = r
param$b = b
param$sigma = sigma
param$criticalValue = I
# Add title and description:
if (is.null(title)) title = "Option On Option Valuation"
if (is.null(description)) description = as.character(date())
# Return Value:
new("fOPTION",
call = match.call(),
parameters = param,
price = result,
title = title,
description = description
)
}
# ------------------------------------------------------------------------------
HolderExtendibleOption =
function(TypeFlag = c("c", "p"), S, X1, X2, time1, Time2, r, b, sigma, A,
title = NULL, description = NULL)
{ # A function implemented by Diethelm Wuertz
# Description:
# Options that can be extended by the Holder
# References:
# Haug, Chapter 2.7.1
# FUNCTION:
# Settings:
TypeFlag = TypeFlag[1]
# Calculate Price:
HolderExtendible = NA
if (TypeFlag == "c") {
result = (max(c(S-X1, GBSOption(TypeFlag = "c", S = S, X = X2,
Time = Time2-time1, r = r, b = b,
sigma = sigma)@price - A, 0))) }
if (TypeFlag == "p") {
result = (max(c(X1-S, GBSOption(TypeFlag = "p", S = S, X = X2,
Time = Time2-time1, r = r, b = b,
sigma = sigma)@price - A, 0))) }
# Parameters:
# TypeFlag = c("c", "p"), S, X1, X2, time1, Time2, r, b, sigma, A
param = list()
param$TypeFlag = TypeFlag
param$S = S
param$X1 = X1
param$X2 = X2
param$time1 = time1
param$Time2 = Time2
param$r = r
param$b = b
param$sigma = sigma
param$A = A
# Add title and description:
if (is.null(title)) title = "Holder Extendible Option Valuation"
if (is.null(description)) description = as.character(date())
# Return Value:
new("fOPTION",
call = match.call(),
parameters = param,
price = result,
title = title,
description = description
)
}
# ------------------------------------------------------------------------------
WriterExtendibleOption =
function(TypeFlag = c("c", "p"), S, X1, X2, time1, Time2, r, b, sigma,
title = NULL, description = NULL)
{ # A function implemented by Diethelm Wuertz
# Description:
# Writer Extendible Options
# References:
# Haug, Chapter 2.7.2
# FUNCTION:
# Settings:
TypeFlag = TypeFlag[1]
rho = sqrt (time1 / Time2)
z1 = (log(S/X2) + (b + sigma^2 / 2) * Time2) / (sigma * sqrt(Time2))
z2 = (log(S/X1) + (b + sigma^2 / 2) * time1) / (sigma * sqrt(time1))
# Calculate Price:
if (TypeFlag == "c")
result = (GBSOption(TypeFlag, S, X1, time1, r, b, sigma)@price
+ S * exp((b - r) * Time2) * CBND(z1, -z2, -rho) - X2
* exp(-r * Time2) * CBND(z1 - sqrt(sigma^2 * Time2),
-z2 + sqrt(sigma^2 * time1), -rho))
if (TypeFlag == "p")
result = (GBSOption(TypeFlag, S, X1, time1, r, b, sigma)@price
+ X2 * exp(-r * Time2) * CBND(-z1 + sqrt(sigma^2 *
Time2), z2 - sqrt(sigma^2 * time1), -rho) - S *
exp((b - r) * Time2) * CBND(-z1, z2, -rho))
# Parameters:
# TypeFlag = c("c", "p"), S, X1, X2, time1, Time2, r, b, sigma
param = list()
param$TypeFlag = TypeFlag
param$S = S
param$X1 = X1
param$X2 = X2
param$time1 = time1
param$Time2 = Time2
param$r = r
param$b = b
param$sigma = sigma
# Add title and description:
if (is.null(title)) title = "Writer Extendible Option Valuation"
if (is.null(description)) description = as.character(date())
# Return Value:
new("fOPTION",
call = match.call(),
parameters = param,
price = result,
title = title,
description = description
)
}
################################################################################
fExoticOptions/R/LookbackOptions.R 0000644 0001762 0000144 00000041127 12323220016 016650 0 ustar ligges users
# This library is free software; you can redistribute it and/or
# modify it under the terms of the GNU Library General Public
# License as published by the Free Software Foundation; either
# version 2 of the License, or (at your option) any later version.
#
# This library is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU Library General Public License for more details.
#
# You should have received a copy of the GNU Library General
# Public License along with this library; if not, write to the
# Free Foundation, Inc., 59 Temple Place, Suite 330, Boston,
# MA 02111-1307 USA
################################################################################
# FUNCTION: DESCRIPTION:
# Lookback Options:
# FloatingStrikeLookbackOption Floating Strike Lookback Option
# FixedStrikeLookbackOption Fixed Strike Lookback Option
# PTFloatingStrikeLookbackOption Partial Floating Strike LB Option
# PTFixedStrikeLookbackOption Partial Fixed Strike LB Option
# ExtremeSpreadOption Extreme Spread Option
################################################################################
FloatingStrikeLookbackOption =
function(TypeFlag = c("c", "p"), S, SMinOrMax, Time, r, b, sigma,
title = NULL, description = NULL)
{ # A function implemented by Diethelm Wuertz
# Description:
# Floating strike lookback options
# References:
# Haug, Chapter 2.9.1
# FUNCTION:
# Comute Settungs:
TypeFlag = TypeFlag[1]
if (TypeFlag == "c") m = SMinOrMax # Min
if (TypeFlag == "p") m = SMinOrMax # Max
a1 = (log(S / m) + (b + sigma^2 / 2) * Time) / (sigma * sqrt(Time))
a2 = a1 - sigma * sqrt (Time)
# Calculate Call and Put:
if (TypeFlag == "c")
FloatingStrikeLookback = (S * exp ((b - r) * Time) * CND(a1) -
m * exp(-r * Time) * CND(a2) + exp
(-r * Time) * sigma^2 / (2 * b) * S
* ((S / m)^(-2 * b / sigma^2) *
CND(-a1 + 2 * b / sigma *
sqrt(Time)) - exp(b * Time) *
CND(-a1)))
if (TypeFlag == "p")
FloatingStrikeLookback = (m * exp (-r * Time) * CND(-a2) - S *
exp((b - r) * Time) * CND(-a1) + exp
(-r * Time) * sigma^2 / (2 * b) * S
* (-(S / m)^(-2 * b / sigma^2) *
CND(a1 - 2 * b / sigma * sqrt(Time))
+ exp(b * Time) * CND(a1)))
# Parameters:
# TypeFlag = c("c", "p"), S, SMinOrMax, Time, r, b, sigma
param = list()
param$TypeFlag = TypeFlag
param$S = S
param$SMinOrMax = SMinOrMax
param$Time = Time
param$r = r
param$b = b
param$sigma = sigma
# Add title and description:
if (is.null(title)) title = "Floating Strike Lookback Option\n"
if (is.null(description)) description = as.character(date())
# Return Value:
new("fOPTION",
call = match.call(),
parameters = param,
price = FloatingStrikeLookback,
title = title,
description = description
)
}
# ------------------------------------------------------------------------------
FixedStrikeLookbackOption =
function(TypeFlag = c("c", "p"), S, SMinOrMax, X, Time, r, b, sigma,
title = NULL, description = NULL)
{ # A function implemented by Diethelm Wuertz
# Description:
# Fixed strike lookback options
# References:
# Haug, Chapter 2.9.2
# FUNCTION:
# Compute Settings:
TypeFlag = TypeFlag[1]
if (TypeFlag == "c") m = SMinOrMax
if (TypeFlag == "p") m = SMinOrMax
d1 = (log(S / X) + (b + sigma^2 / 2) * Time) / (sigma * sqrt(Time))
d2 = d1 - sigma * sqrt (Time)
e1 = (log(S / m) + (b + sigma^2 / 2) * Time) / (sigma * sqrt(Time))
e2 = e1 - sigma * sqrt (Time)
# Calculate Call and Put:
if (TypeFlag == "c" && X > m)
FixedStrikeLookback = (S * exp ((b - r) * Time) * CND(d1) - X
* exp(-r * Time) * CND(d2) + S * exp
(-r * Time) * sigma^2 / (2 * b) * (-(S
/ X)^(-2 * b / sigma^2) * CND(d1 - 2 *
b / sigma * sqrt(Time)) + exp(b * Time)
* CND(d1)))
if (TypeFlag == "c" && X <= m)
FixedStrikeLookback = (exp (-r * Time) * (m - X) + S *
exp((b-r) * Time) * CND(e1) - exp(-r *
Time) * m * CND(e2) + S * exp (-r *
Time) * sigma^2 / (2 * b) * (-(S /
m)^(-2 * b / sigma^2) * CND(e1 - 2 * b
/ sigma * sqrt(Time)) + exp(b * Time) *
CND(e1)))
if (TypeFlag == "p" && X < m)
FixedStrikeLookback = (-S * exp ((b - r) * Time) * CND(-d1) +
X * exp(-r * Time) * CND(-d1 + sigma *
sqrt(Time)) + S * exp (-r * Time) *
sigma^2 / (2 * b) * ((S / X)^(-2 * b /
sigma^2) * CND(-d1 + 2 * b / sigma *
sqrt(Time)) - exp(b*Time) * CND(-d1)))
if (TypeFlag == "p" && X >= m)
FixedStrikeLookback = (exp (-r * Time) * (X - m) - S * exp((b
- r) * Time) * CND(-e1) + exp(-r *
Time) * m * CND(-e1 + sigma *
sqrt(Time)) + exp (-r * Time) * sigma^2
/ (2 * b) * S * ((S / m)^(-2 * b /
sigma^2) * CND(-e1 + 2 * b / sigma *
sqrt(Time)) - exp(b*Time) * CND(-e1)))
# Parameters:
# TypeFlag = c("c", "p"), S, SMinOrMax, X, Time, r, b, sigma
param = list()
param$TypeFlag = TypeFlag
param$S = S
param$SMinOrMax = SMinOrMax
param$X = X
param$Time = Time
param$r = r
param$b = b
param$sigma = sigma
# Add title and description:
if (is.null(title)) title = "Fixed Strike Lookback Option\n"
if (is.null(description)) description = as.character(date())
# Return Value:
new("fOPTION",
call = match.call(),
parameters = param,
price = FixedStrikeLookback,
title = title,
description = description
)
}
# ------------------------------------------------------------------------------
PTFloatingStrikeLookbackOption =
function(TypeFlag = c("c", "p"), S, SMinOrMax, time1, Time2, r, b,
sigma, lambda, title = NULL, description = NULL)
{ # A function implemented by Diethelm Wuertz
# Description:
# Partial-time floating strike lookback options
# References:
# Haug, Chapter 2.9.3
# FUNCTION:
# Compute Settings:
TypeFlag = TypeFlag[1]
T2 = Time2
t1 = time1
if (TypeFlag == "c") m = SMinOrMax
if (TypeFlag == "p") m = SMinOrMax
d1 = (log(S / m) + (b + sigma^2 / 2) * T2) / (sigma * sqrt(T2))
d2 = d1 - sigma * sqrt (T2)
e1 = (b + sigma^2 / 2) * (T2 - t1) / (sigma * sqrt(T2 - t1))
e2 = e1 - sigma * sqrt (T2 - t1)
f1 = (log(S / m) + (b + sigma^2 / 2) * t1) / (sigma * sqrt(t1))
f2 = f1 - sigma * sqrt (t1)
g1 = log (lambda) / (sigma * sqrt(T2))
g2 = log (lambda) / (sigma * sqrt(T2 - t1))
# Calculate Call and Puts:
if (TypeFlag == "c") {
part1 = (S * exp ((b - r) * T2) * CND(d1 - g1) -
lambda * m * exp(-r * T2) * CND(d2 - g1))
part2 = (exp (-r * T2) * sigma^2 / (2 * b) * lambda * S * ((S
/ m)^(-2 * b / sigma^2) * CBND(-f1 + 2*b*sqrt(t1) /
sigma, -d1 + 2 * b * sqrt(T2) / sigma - g1, sqrt(t1 /
T2)) - exp (b * T2) * lambda^(2 * b / sigma^2) *
CBND(-d1 - g1, e1 + g2, -sqrt(1 - t1 / T2))) + S * exp
((b - r)*T2) * CBND(-d1 + g1, e1 - g2, -sqrt(1 - t1 /
T2)))
part3 = (exp (-r*T2) * lambda * m * CBND(-f2, d2 - g1,
-sqrt(t1 / T2)) - exp (-b * (T2-t1)) * exp((b - r)*T2)
* (1 + sigma^2 / (2 * b)) * lambda * S * CND(e2 - g2)
* CND(-f1)) }
if (TypeFlag == "p") {
part1 = (lambda * m * exp (-r * T2) * CND(-d2 + g1) -
S * exp((b - r) * T2) * CND(-d1 + g1))
part2 = (-exp (-r * T2) * sigma^2 / (2 * b) * lambda * S * ((S
/ m)^(-2 * b / sigma^2) * CBND(f1 - 2 * b * sqrt(t1)
/ sigma, d1 - 2 * b * sqrt(T2) / sigma + g1, sqrt(t1
/ T2)) - exp (b * T2) * lambda^(2 * b / sigma^2) *
CBND(d1 + g1, -e1 - g2, -sqrt(1 - t1 / T2))) - S *
exp ((b - r)*T2) * CBND(d1 - g1, -e1 + g2, -sqrt(1 -
t1 / T2)))
part3 = (-exp (-r*T2) * lambda*m * CBND(f2,
-d2 + g1, -sqrt(t1 / T2)) + exp (-b * (T2-t1)) *
exp((b - r)*T2) * (1 + sigma^2 / (2 * b)) * lambda *
S * CND(-e2 + g2) * CND(f1)) }
PartialFloatLookback = part1 + part2 + part3
# Parameters:
# TypeFlag = c("c", "p"), S, SMinOrMax, time1, Time2, r, b, sigma, lambda
param = list()
param$TypeFlag = TypeFlag
param$S = S
param$SMinOrMax
param$time1 = time1
param$Time2 = Time2
param$r = r
param$b = b
param$sigma = sigma
param$lambda = lambda
# Add title and description:
if (is.null(title)) title = "Partial Time Floating Strike Lookback Option"
if (is.null(description)) description = as.character(date())
# Return Value:
new("fOPTION",
call = match.call(),
parameters = param,
price = PartialFloatLookback,
title = title,
description = description
)
}
# ------------------------------------------------------------------------------
PTFixedStrikeLookbackOption =
function(TypeFlag = c("c", "p"), S, X, time1, Time2, r, b, sigma,
title = NULL, description = NULL)
{ # A function implemented by Diethelm Wuertz
# Description:
# Partial Time Fixed Strike Lookback Option
# References:
# Haug, Chapter 2.9.4
# FUNCTION:
# Compute Settings:
TypeFlag = TypeFlag[1]
d1 = ((log(S / X) + (b + sigma^2 / 2) * Time2) /
(sigma * sqrt(Time2)))
d2 = d1 - sigma * sqrt(Time2)
e1 = (((b + sigma^2 / 2) * (Time2 - time1)) /
(sigma * sqrt(Time2 - time1)))
e2 = e1 - sigma * sqrt(Time2 - time1)
f1 = (log(S / X) + (b + sigma^2 / 2) * time1) / (sigma * sqrt(time1))
f2 = f1 - sigma * sqrt(time1)
# Calculate Call and Put:
if (TypeFlag == "c") {
PartialFixedLB = (S * exp((b - r) * Time2) * CND(d1) - exp(-r
* Time2) * X * CND(d2) + S * exp(-r * Time2)
* sigma^2 / (2 * b) * (-(S / X)^(-2 * b /
sigma^2) * CBND(d1 - 2 * b * sqrt(Time2) /
sigma, -f1 + 2 * b * sqrt(time1) / sigma,
-sqrt(time1 / Time2)) + exp(b * Time2) *
CBND(e1, d1, sqrt(1 - time1 / Time2))) - S *
exp((b - r) * Time2) * CBND(-e1, d1, -sqrt(1
- time1 / Time2)) - X * exp(-r * Time2) *
CBND(f2, -d2, -sqrt(time1 / Time2)) + exp(-b
* (Time2 - time1)) * (1 - sigma^2 / (2 * b))
* S * exp((b - r) * Time2) * CND(f1) *
CND(-e2)) }
if (TypeFlag == "p") {
PartialFixedLB = (X * exp(-r * Time2) * CND(-d2) - S * exp((b
- r) * Time2) * CND(-d1) + S * exp(-r *
Time2) * sigma^2 / (2 * b) * ((S / X)^(-2 *
b / sigma^2) * CBND(-d1 + 2 * b *
sqrt(Time2) / sigma, f1 - 2 * b *
sqrt(time1) / sigma, -sqrt(time1 / Time2)) -
exp(b * Time2) * CBND(-e1, -d1, sqrt(1 -
time1 / Time2))) + S * exp((b - r) * Time2)
* CBND(e1, -d1, -sqrt(1 - time1 / Time2)) +
X * exp(-r * Time2) * CBND(-f2, d2,
-sqrt(time1 / Time2)) - exp(-b * (Time2 -
time1)) * (1 - sigma^2 / (2 * b)) * S *
exp((b - r) * Time2) * CND(-f1) * CND(e2)) }
# Parameters:
# TypeFlag = c("c", "p"), S, X, time1, Time2, r, b, sigma
param = list()
param$TypeFlag = TypeFlag
param$S = S
param$X = X
param$time1 = time1
param$Time2 = Time2
param$r = r
param$b = b
param$sigma = sigma
# Add title and description:
if (is.null(title)) title = "Partial Time Fixed Strike Lookback Option"
if (is.null(description)) description = as.character(date())
# Return Value:
new("fOPTION",
call = match.call(),
parameters = param,
price = PartialFixedLB,
title = title,
description = description
)
}
# ------------------------------------------------------------------------------
ExtremeSpreadOption =
function(TypeFlag = c("c", "p", "cr", "pr"), S, SMin, SMax, time1, Time2,
r, b, sigma, title = NULL, description = NULL)
{ # A function implemented by Diethelm Wuertz
# Description:
# Extreme Spread Option
# References:
# Haug, Chapter 2.9.5
# FUNCTION:
# Compute Settings:
TypeFlag = TypeFlag[1]
v = sigma
Time = Time2
if (TypeFlag == "c" || TypeFlag == "cr") { eta = +1 }
if (TypeFlag == "p" || TypeFlag == "pr") { eta = -1 }
if (TypeFlag == "c" || TypeFlag == "p") { kappa = +1 }
if (TypeFlag == "cr" || TypeFlag == "pr") { kappa = -1 }
if (kappa * eta == +1) { Mo = SMax }
if (kappa * eta == -1) { Mo = SMin }
mu1 = b - v^2 / 2
mu = mu1 + v^2
m = log(Mo/S)
ExtremeSpread = NA
# Extreme Spread Option:
if (kappa == 1) {
ExtremeSpread = (eta * (S * exp((b - r) * Time) * (1 + v^2 /
(2 * b)) * CND(eta * (-m + mu * Time) /
(v*sqrt(Time))) - exp(-r * (Time - time1)) *
S * exp((b - r) * Time) * (1 + v^2 / (2 * b))
* CND(eta * (-m + mu * time1) /
(v*sqrt(time1))) + exp(-r * Time) * Mo *
CND(eta * (m - mu1 * Time) / (v*sqrt(Time)))
- exp(-r * Time) * Mo * v^2 / (2 * b) * exp(2
* mu1 * m / v^2) * CND(eta * (-m - mu1 *
Time) / (v*sqrt(Time))) - exp(-r * Time) * Mo
* CND(eta * (m - mu1 * time1) /
(v*sqrt(time1))) + exp(-r * Time) * Mo * v^2
/ (2 * b) * exp(2 * mu1 * m / v^2) * CND(eta
* (-m - mu1 * time1) / (v*sqrt(time1))))) }
# Reverse Extreme Spread Option:
if (kappa == -1) {
ExtremeSpread = (-eta * (S * exp((b - r) * Time) * (1 + v^2 /
(2 * b)) * CND(eta * (m - mu * Time) /
(v*sqrt(Time))) + exp(-r * Time) * Mo *
CND(eta * (-m + mu1 * Time) / (v*sqrt(Time)))
- exp(-r * Time) * Mo * v^2 / (2 * b) * exp(2
* mu1 * m / v^2) * CND(eta * (m + mu1 * Time)
/ (v*sqrt(Time))) - S * exp((b - r) * Time) *
(1 + v^2 / (2 * b)) * CND(eta * (-mu * (Time
- time1)) / (v*sqrt(Time - time1))) - exp(-r
* (Time - time1)) * S * exp((b - r) * Time) *
(1 - v^2 / (2 * b)) * CND(eta * (mu1 * (Time
- time1)) / (v*sqrt(Time - time1))))) }
# Parameters:
# TypeFlag = c("c", "p", "cr", "pr"), S, SMin, SMax, time1, Time2,
# r, b, sigma
param = list()
param$TypeFlag = TypeFlag
param$S = S
param$SMin = SMin
param$SMax = SMax
param$time1 = time1
param$Time2 = Time2
param$r = r
param$b = b
param$sigma = sigma
# Add title and description:
if (is.null(title)) title = "Extreme Spread Option"
if (is.null(description)) description = as.character(date())
# Return Value:
new("fOPTION",
call = match.call(),
parameters = param,
price = ExtremeSpread,
title = title,
description = description
)
}
################################################################################
fExoticOptions/R/AsianOptions.R 0000644 0001762 0000144 00000014661 12323220016 016161 0 ustar ligges users
# This library is free software; you can redistribute it and/or
# modify it under the terms of the GNU Library General Public
# License as published by the Free Software Foundation; either
# version 2 of the License, or (at your option) any later version.
#
# This library is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU Library General Public License for more details.
#
# You should have received a copy of the GNU Library General
# Public License along with this library; if not, write to the
# Free Foundation, Inc., 59 Temple Place, Suite 330, Boston,
# MA 02111-1307 USA
################################################################################
# FUNCTION: DESCRIPTION:
# Asian Options:
# GeometricAverageRateOption Geometric Average Rate Option
# TurnbullWakemanAsianApproxOption Turnbull-Wakeman Approximated Asian Option
# LevyAsianApproxOption Levy Approximated Asian Option
################################################################################
GeometricAverageRateOption =
function(TypeFlag = c("c", "p"), S, X, Time, r, b, sigma,
title = NULL, description = NULL)
{ # A function implemented by Diethelm Wuertz
# Description:
# Valuates geometric average rate options
# References:
# Kemma and Vorst (1990)
# Haug, Chapter 2.12.1
# FUNCTION:
# Compute Price:
TypeFlag = TypeFlag[1]
b.A = 0.5 * (b - sigma^2 / 6)
sigma.A = sigma / sqrt (3)
GeometricAverageRate =
GBSOption (TypeFlag = TypeFlag, S = S, X = X, Time = Time,
r = r, b = b.A, sigma = sigma.A)@price
# Parameters:
# TypeFlag = c("c", "p"), S, X, Time, r, b, sigma
param = list()
param$TypeFlag = TypeFlag
param$S = S
param$X = X
param$Time = Time
param$r = r
param$b = b
param$sigma = sigma
# Add title and description:
if (is.null(title)) title = "Geometric Average Rate Option"
if (is.null(description)) description = as.character(date())
# Return Value:
new("fOPTION",
call = match.call(),
parameters = param,
price = GeometricAverageRate,
title = title,
description = description
)
}
# ------------------------------------------------------------------------------
TurnbullWakemanAsianApproxOption =
function(TypeFlag = c("c", "p"), S, SA, X, Time, time, tau, r, b, sigma,
title = NULL, description = NULL)
{ # A function implemented by Diethelm Wuertz
# Description:
# Valuates arithmetic average rate options by the
# Turnbull-Wakeman's Approximation
# References:
# Haug, Chapter 2.12.2
# FUNCTION:
# Compute Price:
TypeFlag = TypeFlag[1]
m1 = (exp(b * Time) - exp(b * tau)) / (b * (Time - tau))
m2 = (2 * exp((2 * b + sigma^2) * Time) / ((b + sigma^2) * (2*b +
sigma^2) * (Time - tau)^2) + 2 * exp((2 * b + sigma^2) *
tau) / (b * (Time - tau)^2) * (1/(2 * b + sigma^2) - exp(b *
(Time - tau)) / (b + sigma^2)))
b.A = log(m1) / Time
sigma.A = sqrt(log(m2) / Time - 2*b.A)
t1 = Time - time
if (t1 > 0) {
X = Time/time * X - t1/time * SA
TurnbullWakemanAsianApprox =
(GBSOption(TypeFlag, S, X, time, r, b.A, sigma.A)@price *
time/Time) }
else {
TurnbullWakemanAsianApprox =
GBSOption(TypeFlag, S, X, time, r, b.A, sigma.A)@price }
# Parameters:
# TypeFlag = c("c", "p"), S, SA, X, Time, time, tau, r, b, sigma
param = list()
param$TypeFlag = TypeFlag
param$S = S
param$SA = SA
param$X = X
param$Time = Time
param$time = time
param$tau = tau
param$r = r
param$b = b
param$sigma = sigma
# Add title and description:
if (is.null(title)) title = "Turnbull Wakeman Asian Approximated Option"
if (is.null(description)) description = as.character(date())
# Return Value:
new("fOPTION",
call = match.call(),
parameters = param,
price = TurnbullWakemanAsianApprox,
title = title,
description = description
)
}
# ------------------------------------------------------------------------------
LevyAsianApproxOption =
function(TypeFlag = c("c", "p"), S, SA, X, Time, time, r, b, sigma,
title = NULL, description = NULL)
{ # A function implemented by Diethelm Wuertz
# Description:
# Valuates arithmetic average rate options by the
# Levy Approximation
# References:
# Haug, Chapter 2.12.2
# FUNCTION:
# Compute Price:
TypeFlag = TypeFlag[1]
SE = S / (Time*b) * (exp((b-r)*time) - exp(-r*time))
m = 2 * S ^ 2 / (b + sigma ^ 2) * ((exp((2 *
b + sigma^2) * time) - 1) / (2 * b + sigma^2) -
(exp(b * time) - 1) / b)
d = m / (Time^2)
Sv = log (d) - 2 * (r * time + log(SE))
XStar = X - (Time - time) / Time * SA
d1 = 1 / sqrt (Sv) * (log(d) / 2 - log(XStar))
d2 = d1 - sqrt (Sv)
if (TypeFlag == "c") {
LevyAsianApprox = (SE * CND (d1) - XStar * exp(-r*time) *
CND(d2))}
if (TypeFlag == "p") {
LevyAsianApprox = ((SE * CND(d1) - XStar * exp(-r*time) *
CND(d2)) - SE + XStar * exp (-r*time)) }
# Parameters:
# TypeFlag = c("c", "p"), S, SA, X, Time, time, r, b, sigma
param = list()
param$TypeFlag = TypeFlag
param$S = S
param$SA = SA
param$X = X
param$Time = Time
param$time = time
param$r = r
param$b = b
param$sigma = sigma
# Add title and description:
if (is.null(title)) title = "Levy Asian Approximated Option"
if (is.null(description)) description = as.character(date())
# Return Value:
new("fOPTION",
call = match.call(),
parameters = param,
price = LevyAsianApprox,
title = title,
description = description
)
}
# ------------------------------------------------------------------------------
#CurranAsianApproxOption =
#function()
#{ # A function implemented by Diethelm Wuertz
# Description:
# Arithmetic average rate option
# Curran's Approximation
# References:
# Haug, Chapter 2.12.2
# FUNCTION:
# Compute Price:
# CurranAsianApprox = NA
# Return Value:
# CurranAsianApprox
#}
################################################################################
fExoticOptions/R/BarrierOptions.R 0000644 0001762 0000144 00000073467 12323220016 016525 0 ustar ligges users
# This library is free software; you can redistribute it and/or
# modify it under the terms of the GNU Library General Public
# License as published by the Free Software Foundation; either
# version 2 of the License, or (at your option) any later version.
#
# This library is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU Library General Public License for more details.
#
# You should have received a copy of the GNU Library General
# Public License along with this library; if not, write to the
# Free Foundation, Inc., 59 Temple Place, Suite 330, Boston,
# MA 02111-1307 USA
################################################################################
# FUNCTION: DESCRIPTION:
# Barrier Options:
# StandardBarrierOption Standard Barrier Option
# DoubleBarrierOption Double Barrier Option
# PTSingleAssetBarrierOption Partial Time Barrier Option
# TwoAssetBarrierOption Two Asset Barrier
# PTTwoAssetBarrierOption Partial Time TwoAsset Barrier Option
# LookBarrierOption Look Barrier Option
# DiscreteBarrierOption Discrete Adjusted Barrier Option
# SoftBarrierOption Soft Barrier Option
################################################################################
StandardBarrierOption =
function(TypeFlag = c("cdi", "cui", "pdi", "pui", "cdo", "cuo", "pdo", "puo"),
S, X, H, K, Time, r, b, sigma, title = NULL, description = NULL)
{ # A function implemented by Diethelm Wuertz
# Description:
# Standard Barrier Options
# References:
# Haug, Chapter 2.10.1
# FUNCTION:
# Compute:
TypeFlag = TypeFlag[1]
StandardBarrier = NA
mu = (b - sigma ^ 2 / 2) / sigma ^ 2
lambda = sqrt (mu ^ 2 + 2 * r / sigma ^ 2)
X1 = log (S / X) / (sigma * sqrt(Time)) + (1 + mu) * sigma * sqrt(Time)
X2 = log (S / H) / (sigma * sqrt(Time)) + (1 + mu) * sigma * sqrt(Time)
y1 = (log (H ^ 2 / (S * X)) / (sigma * sqrt(Time)) + (1 + mu) * sigma *
sqrt(Time))
y2 = log (H / S) / (sigma * sqrt(Time)) + (1 + mu) * sigma * sqrt(Time)
Z = log (H / S) / (sigma * sqrt(Time)) + lambda * sigma * sqrt(Time)
if (TypeFlag == "cdi" || TypeFlag == "cdo") { eta = +1; phi = +1 }
if (TypeFlag == "cui" || TypeFlag == "cuo") { eta = -1; phi = +1 }
if (TypeFlag == "pdi" || TypeFlag == "pdo") { eta = +1; phi = -1 }
if (TypeFlag == "pui" || TypeFlag == "puo") { eta = -1; phi = -1 }
f1 = (phi * S * exp ((b - r) * Time) * CND(phi * X1) -
phi * X * exp(-r * Time) * CND(phi * X1 - phi * sigma * sqrt(Time)))
f2 = (phi * S * exp ((b - r) * Time) * CND(phi * X2) -
phi * X * exp(-r * Time) * CND(phi * X2 - phi * sigma * sqrt(Time)))
f3 = (phi * S * exp ((b - r) * Time) * (H / S) ^ (2 * (mu + 1)) *
CND(eta * y1) - phi * X * exp(-r * Time) * (H / S) ^ (2 * mu) *
CND(eta * y1 - eta * sigma * sqrt(Time)))
f4 = (phi * S * exp ((b - r) * Time) * (H / S) ^ (2 * (mu + 1)) *
CND(eta * y2) - phi * X * exp(-r * Time) * (H / S) ^ (2 * mu) *
CND(eta * y2 - eta * sigma * sqrt(Time)))
f5 = (K * exp (-r * Time) * (CND(eta * X2 - eta * sigma *
sqrt(Time)) - (H / S) ^ (2 * mu) * CND(eta * y2 - eta *
sigma * sqrt(Time))))
f6 = (K * ((H / S) ^ (mu + lambda) * CND(eta * Z) + (H / S)^(mu - lambda) *
CND(eta * Z - 2 * eta * lambda * sigma * sqrt(Time))))
if (X >= H) {
if (TypeFlag == "cdi") StandardBarrier = f3 + f5
if (TypeFlag == "cui") StandardBarrier = f1 + f5
if (TypeFlag == "pdi") StandardBarrier = f2 - f3 + f4 + f5
if (TypeFlag == "pui") StandardBarrier = f1 - f2 + f4 + f5
if (TypeFlag == "cdo") StandardBarrier = f1 - f3 + f6
if (TypeFlag == "cuo") StandardBarrier = f6
if (TypeFlag == "pdo") StandardBarrier = f1 - f2 + f3 - f4 + f6
if (TypeFlag == "puo") StandardBarrier = f2 - f4 + f6 }
if (X < H) {
if (TypeFlag == "cdi") StandardBarrier = f1 - f2 + f4 + f5
if (TypeFlag == "cui") StandardBarrier = f2 - f3 + f4 + f5
if (TypeFlag == "pdi") StandardBarrier = f1 + f5
if (TypeFlag == "pui") StandardBarrier = f3 + f5
if (TypeFlag == "cdo") StandardBarrier = f2 + f6 - f4
if (TypeFlag == "cuo") StandardBarrier = f1 - f2 + f3 - f4 + f6
if (TypeFlag == "pdo") StandardBarrier = f6
if (TypeFlag == "puo") StandardBarrier = f1 - f3 + f6 }
# Parameters:
# TypeFlag = c("cdi", "cui", "pdi", "pui", "cdo", "cuo", "pdo", "puo"),
# S, X, H, K, Time, r, b, sigma
param = list()
param$TypeFlag = TypeFlag
param$S = S
param$X = X
param$H = H
param$K = K
param$Time = Time
param$r = r
param$b = b
param$sigma = sigma
# Add title and description:
if (is.null(title)) title = "Standard Barrier Option"
if (is.null(description)) description = as.character(date())
# Return Value:
new("fOPTION",
call = match.call(),
parameters = param,
price = StandardBarrier,
title = title,
description = description
)
}
# ------------------------------------------------------------------------------
DoubleBarrierOption =
function(TypeFlag = c("co", "ci", "po", "pi"), S, X, L, U, Time, r, b,
sigma, delta1, delta2, title = NULL, description = NULL)
{ # A function implemented by Diethelm Wuertz
# Description:
# Double barrier options
# References:
# Haug, Chapter 2.10.2
# FUNCTION:
# Compute:
TypeFlag = TypeFlag[1]
DoubleBarrier = NA
FU = U * exp (delta1 * Time)
E = L * exp (delta1 * Time)
Sum1 = Sum2 = 0
# Call:
if (TypeFlag == "co" || TypeFlag == "ci") {
for (n in -5:5) {
d1 = ((log(S * U ^ (2 * n) / (X * L ^ (2 * n))) +
(b + sigma ^ 2 / 2) * Time) / (sigma * sqrt(Time)))
d2 = ((log(S * U ^ (2 * n) / (FU * L ^ (2 * n))) +
(b + sigma ^ 2 / 2) * Time) / (sigma * sqrt(Time)))
d3 = ((log(L ^ (2 * n + 2) / (X * S * U ^ (2 * n))) +
(b + sigma ^ 2 / 2) * Time) / (sigma * sqrt(Time)))
d4 = ((log(L ^ (2 * n + 2) / (FU * S * U ^ (2 * n))) +
(b + sigma ^ 2 / 2) * Time) / (sigma * sqrt(Time)))
mu1 = 2 * (b - delta2 - n * (delta1 - delta2)) / sigma^2 + 1
mu2 = 2 * n * (delta1 - delta2) / sigma^2
mu3 = 2 * (b - delta2 + n * (delta1 - delta2)) / sigma^2 + 1
Sum1 = (Sum1 + (U^n / L ^ n) ^ mu1 * (L / S) ^ mu2 *
(CND(d1) - CND(d2)) - (L^(n + 1) / (U ^ n * S)) ^ mu3 *
(CND(d3) - CND(d4)))
Sum2 = (Sum2 + (U^n / L ^ n) ^ (mu1 - 2) * (L/S)^mu2 *
(CND(d1 - sigma * sqrt(Time)) - CND(d2 - sigma * sqrt(Time))) -
(L^(n + 1) / (U ^ n * S))^(mu3 - 2) *
(CND(d3 - sigma * sqrt(Time)) - CND(d4 - sigma * sqrt(Time))))
}
OutValue = S * exp ((b-r)*Time) * Sum1 - X * exp(-r*Time) * Sum2 }
# Put:
if (TypeFlag == "po" || TypeFlag == "pi") {
for ( n in (-5:5) ) {
d1 = ((log(S * U ^ (2 * n) / (E * L ^ (2 * n))) +
(b + sigma ^ 2 / 2) * Time) / (sigma * sqrt(Time)))
d2 = ((log(S * U ^ (2 * n) / (X * L ^ (2 * n))) +
(b + sigma ^ 2 / 2) * Time) / (sigma * sqrt(Time)))
d3 = ((log(L ^ (2 * n + 2) / (E * S * U ^ (2 * n))) +
(b + sigma ^ 2 / 2) * Time) / (sigma * sqrt(Time)))
d4 = ((log(L ^ (2 * n + 2) / (X * S * U ^ (2 * n))) +
(b + sigma ^ 2 / 2) * Time) / (sigma * sqrt(Time)))
mu1 = 2 * (b - delta2 - n * (delta1 - delta2)) / sigma ^ 2 + 1
mu2 = 2 * n * (delta1 - delta2) / sigma ^ 2
mu3 = 2 * (b - delta2 + n * (delta1 - delta2)) / sigma ^ 2 + 1
Sum1 = (Sum1 + (U^n / L^n)^mu1 * (L / S) ^ mu2 *
(CND(d1) - CND(d2)) -
(L ^ (n + 1) / (U ^ n * S)) ^ mu3 *
(CND(d3) - CND(d4)))
Sum2 = (Sum2 + (U ^n / L^n)^(mu1 - 2) * (L/S)^mu2 *
(CND(d1 - sigma * sqrt(Time)) - CND(d2 - sigma * sqrt(Time))) -
(L^(n + 1) / (U ^ n * S))^(mu3 - 2) *
(CND(d3 - sigma * sqrt(Time)) - CND(d4 - sigma * sqrt(Time))))
}
OutValue = X * exp (-r*Time) * Sum2 - S * exp((b - r)*Time) * Sum1 }
# Final Values:
if (TypeFlag == "co" || TypeFlag == "po")
DoubleBarrier = OutValue
if (TypeFlag == "ci")
DoubleBarrier = GBSOption("c", S, X, Time, r, b, sigma)@price - OutValue
if (TypeFlag == "pi")
DoubleBarrier = GBSOption("p", S, X, Time, r, b, sigma)@price - OutValue
# Parameters:
# TypeFlag = c("co", "ci", "po", "pi"), S, X, L, U, Time, r, b,
# sigma, delta1, delta2
param = list()
param$TypeFlag = TypeFlag
param$S = S
param$X = X
param$L = L
param$U = U
param$Time = Time
param$r = r
param$b = b
param$sigma = sigma
param$delta1 = delta1
param$delta2 = delta2
# Add title and description:
if (is.null(title)) title = "Double Barrier Option"
if (is.null(description)) description = as.character(date())
# Return Value:
new("fOPTION",
call = match.call(),
parameters = param,
price = DoubleBarrier,
title = title,
description = description
)
}
# ------------------------------------------------------------------------------
PTSingleAssetBarrierOption =
function(TypeFlag = c("cdoA", "cuoA", "pdoA", "puoA", "coB1", "poB1",
"cdoB2", "cuoB2"), S, X, H, time1, Time2, r, b, sigma, title = NULL,
description = NULL)
{ # A function implemented by Diethelm Wuertz
# Description:
# Partial-time single asset barrier options
# References:
# Haug, Chapter 2.10.3
# FUNCTION:
# Compute:
TypeFlag = TypeFlag[1]
PartialTimeBarrier = NA
t1 = time1
T2 = Time2
if (TypeFlag == "cdoA") eta = 1
if (TypeFlag == "cuoA") eta = -1
# Continue:
d1 = (log(S/X) + (b + sigma^2/2) * T2) / (sigma * sqrt(T2))
d2 = d1 - sigma * sqrt (T2)
f1 = (log(S/X) + 2 * log(H/S) + (b + sigma^2/2) * T2) / (sigma * sqrt(T2))
f2 = f1 - sigma * sqrt (T2)
e1 = (log(S / H) + (b + sigma ^ 2 / 2) * t1) / (sigma * sqrt(t1))
e2 = e1 - sigma * sqrt (t1)
e3 = e1 + 2 * log (H / S) / (sigma * sqrt(t1))
e4 = e3 - sigma * sqrt (t1)
mu = (b - sigma ^ 2 / 2) / sigma ^ 2
rho = sqrt (t1 / T2)
g1 = (log(S / H) + (b + sigma ^ 2 / 2) * T2) / (sigma * sqrt(T2))
g2 = g1 - sigma * sqrt (T2)
g3 = g1 + 2 * log (H / S) / (sigma * sqrt(T2))
g4 = g3 - sigma * sqrt (T2)
z1 = CND (e2) - (H / S) ^ (2 * mu) * CND(e4)
z2 = CND (-e2) - (H / S) ^ (2 * mu) * CND(-e4)
z3 = CBND (g2, e2, rho) - (H / S) ^ (2 * mu) * CBND(g4, -e4, -rho)
z4 = CBND (-g2, -e2, rho) - (H / S) ^ (2 * mu) * CBND(-g4, e4, -rho)
z5 = CND (e1) - (H / S) ^ (2 * (mu + 1)) * CND(e3)
z6 = CND (-e1) - (H / S) ^ (2 * (mu + 1)) * CND(-e3)
z7 = CBND (g1, e1, rho) - (H / S) ^ (2 * (mu + 1)) * CBND(g3, -e3, -rho)
z8 = CBND (-g1, -e1, rho) - (H / S) ^ (2 * (mu + 1)) * CBND(-g3, e3, -rho)
if (TypeFlag == "cdoA" || TypeFlag == "cuoA") {
# call down-and out and up-and-out type A
PartialTimeBarrier =
(S * exp ((b - r) * T2) * (CBND(d1, eta * e1, eta * rho) -
(H / S) ^ (2 * (mu + 1)) * CBND(f1, eta * e3, eta * rho))
- X * exp (-r * T2) * (CBND(d2, eta * e2, eta * rho) - (H
/ S) ^ (2 * mu) * CBND(f2, eta * e4, eta * rho))) }
if (TypeFlag == "cdoB2" && X < H) {
# call down-and-out type B2
PartialTimeBarrier =
(S * exp ((b - r) * T2) * (CBND(g1, e1, rho) - (H / S) ^
(2 * (mu + 1)) * CBND(g3, -e3, -rho)) - X * exp (-r * T2)
* (CBND(g2, e2, rho) - (H / S) ^ (2 * mu) * CBND(g4, -e4,
-rho))) }
if (TypeFlag == "cdoB2" && X > H) {
PartialTimeBarrier = (PTSingleAssetBarrierOption("coB1", S, X, H, t1,
T2, r, b, sigma)@price) }
if (TypeFlag == "cuoB2" && X < H) {
# call up-and-out type B2
PartialTimeBarrier =
(S * exp ((b - r) * T2) * (CBND(-g1, -e1, rho) - (H / S) ^
(2 * (mu + 1)) * CBND(-g3, e3, -rho)) - X * exp (-r * T2)
* (CBND(-g2, -e2, rho) - (H / S) ^ (2 * mu) * CBND(-g4,
e4, -rho)) - S * exp ((b - r) * T2) * (CBND(-d1, -e1, rho)
- (H / S) ^ (2 * (mu + 1)) * CBND(e3, -f1, -rho)) + X *
exp (-r * T2) * (CBND(-d2, -e2, rho) - (H / S) ^ (2 * mu)
* CBND(e4, -f2, -rho)))}
if (TypeFlag == "coB1" && X > H) {
# call out type B1
PartialTimeBarrier =
(S * exp ((b - r) * T2) * (CBND(d1, e1, rho) - (H / S) ^
(2 * (mu + 1)) * CBND(f1, -e3, -rho)) - X * exp (-r * T2)
* (CBND(d2, e2, rho) - (H / S) ^ (2 * mu) * CBND(f2, -e4,
-rho))) }
if (TypeFlag == "coB1" && X < H) {
PartialTimeBarrier =
(S * exp ((b - r) * T2) * (CBND(-g1, -e1, rho) - (H / S) ^
(2 * (mu + 1)) * CBND(-g3, e3, -rho)) - X * exp (-r * T2)
* (CBND(-g2, -e2, rho) - (H / S) ^ (2 * mu) * CBND(-g4,
e4, -rho)) - S * exp ((b - r) * T2) * (CBND(-d1, -e1, rho)
- (H / S) ^ (2 * (mu + 1)) * CBND(-f1, e3, -rho)) + X *
exp (-r * T2) * (CBND(-d2, -e2, rho) - (H / S) ^ (2 * mu)
* CBND(-f2, e4, -rho)) + S * exp ((b - r) * T2) *
(CBND(g1, e1, rho) - (H / S) ^ (2 * (mu + 1)) * CBND(g3,
-e3, -rho)) - X * exp (-r * T2) * (CBND(g2, e2, rho) - (H
/ S) ^ (2 * mu) * CBND(g4, -e4, -rho))) }
if (TypeFlag == "pdoA") {
# put down-and out and up-and-out type A
PartialTimeBarrier = (PTSingleAssetBarrierOption("cdoA",
S, X, H, t1, T2, r, b, sigma)@price -
S * exp((b - r) * T2) * z5 + X * exp(-r * T2) * z1)}
if (TypeFlag == "puoA") {
PartialTimeBarrier = (PTSingleAssetBarrierOption("cuoA",
S, X, H, t1, T2, r, b, sigma)@price -
S * exp((b - r) * T2) * z6 + X * exp(-r * T2) * z2) }
if (TypeFlag == "poB1") {
# put out type B1
PartialTimeBarrier = (PTSingleAssetBarrierOption("coB1",
S, X, H, t1, T2, r, b, sigma)@price -
S * exp((b - r) * T2) * z8 + X * exp(-r * T2) * z4 -
S * exp((b - r) * T2) * z7 + X * exp(-r * T2) * z3) }
if (TypeFlag == "pdoB2") {
# put down-and-out type B2
PartialTimeBarrier = (PTSingleAssetBarrierOption("cdoB2",
S, X, H, t1, T2, r, b, sigma)@price -
S * exp((b - r) * T2) * z7 + X * exp(-r * T2) * z3) }
if (TypeFlag == "puoB2") {
# put up-and-out type B2
PartialTimeBarrier = (PTSingleAssetBarrierOption("cuoB2",
S, X, H, t1, T2, r, b, sigma)@price -
S * exp((b - r) * T2) * z8 + X * exp(-r * T2) * z4) }
# Parameters:
# TypeFlag = c("cdoA", "cuoA", "pdoA", "puoA", "coB1", "poB1",
# "cdoB2", "cuoB2"), S, X, H, time1, Time2, r, b, sigma
param = list()
param$TypeFlag = TypeFlag
param$S = S
param$X = X
param$H = H
param$time1 = time1
param$Time2 = Time2
param$r = r
param$b = b
param$sigma = sigma
# Add title and description:
if (is.null(title)) title = "Partial Time Single Asset Barrier Option"
if (is.null(description)) description = as.character(date())
# Return Value:
new("fOPTION",
call = match.call(),
parameters = param,
price = PartialTimeBarrier,
title = title,
description = description
)
}
# ------------------------------------------------------------------------------
TwoAssetBarrierOption =
function(TypeFlag = c("cuo", "cui", "cdo", "cdi", "puo", "pui", "pdo", "pdi"),
S1, S2, X, H, Time, r, b1, b2, sigma1, sigma2, rho, title = NULL,
description = NULL)
{ # A function implemented by Diethelm Wuertz
# Description:
# Partial-time singel asset barrier options
# References:
# Haug, Chapter 2.10.4
# FUNCTION:
# Compute:
TypeFlag = TypeFlag[1]
v1 = sigma1
v2 = sigma2
mu1 = b1 - v1 ^ 2 / 2
mu2 = b2 - v2 ^ 2 / 2
d1 = (log(S1 / X) + (mu1 + v1 ^ 2 / 2) * Time) / (v1 * sqrt(Time))
d2 = d1 - v1 * sqrt (Time)
d3 = d1 + 2 * rho * log (H / S2) / (v2 * sqrt(Time))
d4 = d2 + 2 * rho * log (H / S2) / (v2 * sqrt(Time))
e1 = (log(H / S2) - (mu2 + rho * v1 * v2) * Time) / (v2 * sqrt(Time))
e2 = e1 + rho * v1 * sqrt (Time)
e3 = e1 - 2 * log (H / S2) / (v2 * sqrt(Time))
e4 = e2 - 2 * log (H / S2) / (v2 * sqrt(Time))
# Make Decisions:
if (TypeFlag == "cuo" || TypeFlag == "cui") {
eta = 1
phi = 1 }
if (TypeFlag == "cdo" || TypeFlag == "cdi") {
eta = 1
phi = -1 }
if (TypeFlag == "puo" || TypeFlag == "pui") {
eta = -1
phi = 1 }
if (TypeFlag == "pdo" || TypeFlag == "pdi") {
eta = -1
phi = -1 }
# Calculate Knock Out Value:
KnockOutValue =
(eta * S1 * exp ((b1 - r) * Time) * (CBND ( eta * d1, phi *
e1, -eta * phi * rho) - exp (2 * (mu2 + rho * v1 * v2) *
log(H / S2) / v2 ^ 2) * CBND(eta * d3, phi * e3, -eta * phi *
rho)) - eta * exp(-r * Time) * X * (CBND(eta * d2, phi * e2,
-eta * phi * rho) - exp (2 * mu2 * log(H / S2) / v2 ^ 2) *
CBND(eta * d4, phi * e4, -eta * phi * rho)))
# Calculate Two Asset Barrier:
if (TypeFlag == "cuo" || TypeFlag == "cdo" ||
TypeFlag == "puo" || TypeFlag == "pdo")
TwoAssetBarrier = KnockOutValue
if (TypeFlag == "cui" || TypeFlag == "cdi")
TwoAssetBarrier = (GBSOption("c", S1, X, Time, r, b1, v1)@price -
KnockOutValue)
if (TypeFlag == "pui" || TypeFlag == "pdi")
TwoAssetBarrier = (GBSOption("p", S1, X, Time, r, b1, v1)@price -
KnockOutValue)
# Parameters:
# TypeFlag = c("cuo", "cui", "cdo", "cdi", "puo", "pui", "pdo", "pdi"),
# S1, S2, X, H, Time, r, b1, b2, sigma1, sigma2, rho
param = list()
param$TypeFlag = TypeFlag
param$S1 = S1
param$S2 = S2
param$X = X
param$H = H
param$Time = Time
param$r = r
param$b1 = b1
param$b2 = b2
param$sigma1 = sigma1
param$sigma2 = sigma2
param$rho = rho
# Add title and description:
if (is.null(title)) title = "Two Asset Barrier Option"
if (is.null(description)) description = as.character(date())
# Return Value:
new("fOPTION",
call = match.call(),
parameters = param,
price = TwoAssetBarrier,
title = title,
description = description
)
}
# ------------------------------------------------------------------------------
PTTwoAssetBarrierOption =
function(TypeFlag = c("cdo", "pdo", "cdi", "pdi", "cuo", "puo", "cui", "pui"),
S1, S2, X, H, time1, Time2, r, b1, b2, sigma1, sigma2, rho, title = NULL,
description = NULL)
{ # A function implemented by Diethelm Wuertz
# Description:
# Partial-time two asset barrier options
# References:
# Haug, Chapter 2.10.5
# FUNCTION:
# Compute:
TypeFlag = TypeFlag[1]
t1 = time1
T2 = Time2
v1 = sigma1
v2 = sigma2
if (TypeFlag == "cdo" || TypeFlag == "pdo" ||
TypeFlag == "cdi" || TypeFlag == "pdi") {
phi = -1 }
else {
phi = 1 }
if (TypeFlag == "cdo" || TypeFlag == "cuo" ||
TypeFlag == "cdi" || TypeFlag == "cui") {
eta = 1 }
else {
eta = -1 }
mu1 = b1 - v1 ^ 2 / 2
mu2 = b2 - v2 ^ 2 / 2
d1 = (log(S1 / X) + (mu1 + v1 ^ 2) * T2) / (v1 * sqrt(T2))
d2 = d1 - v1 * sqrt (T2)
d3 = d1 + 2 * rho * log (H / S2) / (v2 * sqrt(T2))
d4 = d2 + 2 * rho * log (H / S2) / (v2 * sqrt(T2))
e1 = (log(H / S2) - (mu2 + rho * v1 * v2) * t1) / (v2 * sqrt(t1))
e2 = e1 + rho * v1 * sqrt (t1)
e3 = e1 - 2 * log (H / S2) / (v2 * sqrt(t1))
e4 = e2 - 2 * log (H / S2) / (v2 * sqrt(t1))
OutBarrierValue =
(eta * S1 * exp ((b1 - r) * T2) * (CBND(eta * d1, phi * e1,
-eta * phi * rho * sqrt(t1 / T2)) - exp(2 * log(H / S2) *
(mu2 + rho * v1 * v2) / (v2 ^ 2)) * CBND (eta * d3, phi * e3,
-eta * phi * rho * sqrt(t1 / T2))) - eta * exp (-r * T2) * X
* (CBND(eta * d2, phi * e2, -eta * phi * rho * sqrt(t1 / T2))
- exp(2 * log(H / S2) * mu2 / (v2 ^ 2)) * CBND (eta * d4, phi
* e4, -eta * phi * rho * sqrt(t1 / T2))))
if (TypeFlag == "cdo" || TypeFlag == "cuo" ||
TypeFlag == "pdo" || TypeFlag == "puo")
PartialTimeTwoAssetBarrier = OutBarrierValue
if (TypeFlag == "cui" || TypeFlag == "cdi")
PartialTimeTwoAssetBarrier = (GBSOption("c", S1, X, T2, r, b1, v1)@price -
OutBarrierValue)
if (TypeFlag == "pui" || TypeFlag == "pdi")
PartialTimeTwoAssetBarrier = (GBSOption("p", S1, X, T2, r, b1, v1)@price -
OutBarrierValue)
# Parameters:
# TypeFlag = c("cdo", "pdo", "cdi", "pdi", "cuo", "puo", "cui", "pui"),
# S1, S2, X, H, time1, Time2, r, b1, b2, sigma1, sigma2, rho
param = list()
param$TypeFlag = TypeFlag
param$S1 = S1
param$S2 = S2
param$X = X
param$H = H
param$time1 = time1
param$Time2 = Time2
param$r = r
param$b1 = b1
param$b2 = b2
param$sigma1 = sigma1
param$sigma2 = sigma2
param$rho
# Add title and description:
if (is.null(title)) title = "Partial Time Two Asset Barrier Option"
if (is.null(description)) description = as.character(date())
# Return Value:
new("fOPTION",
call = match.call(),
parameters = param,
price = PartialTimeTwoAssetBarrier,
title = title,
description = description
)
}
# ------------------------------------------------------------------------------
LookBarrierOption =
function(TypeFlag = c("cuo", "cui", "pdo", "pdi"), S, X, H, time1, Time2,
r, b, sigma, title = NULL, description = NULL)
{ # A function implemented by Diethelm Wuertz
# Description:
# Look-Barrier Options
# References:
# Haug, Chapter 2.10.6
# FUNCTION:
# Compute:
TypeFlag = TypeFlag[1]
t1 = time1
T2 = Time2
# Take care of the limit t1 -> T2
if (T2 == t1) t1 = t1*(1-1.0e-12)
v = sigma
hh = log(H/S)
K = log(X/S)
mu1 = b - sigma^2/2
mu2 = b + sigma^2/2
rho = sqrt(t1/T2)
# Make Decisions - Settings:
if (TypeFlag == "cuo" || TypeFlag == "cui") {
eta = +1
m = min (hh, K) }
if (TypeFlag == "pdo" || TypeFlag == "pdi") {
eta = -1
m = max (hh, K) }
# Compute the g Values:
g1 = ((CND(eta * (hh - mu2 * t1) / (sigma * sqrt(t1))) - exp(2 *
mu2 * hh / sigma ^ 2) * CND(eta * (-hh - mu2 * t1) / (sigma
* sqrt(t1)))) - (CND(eta * (m - mu2 * t1) / (sigma *
sqrt(t1))) - exp(2 * mu2 * hh / sigma ^ 2) * CND(eta * (m -
2 * hh - mu2 * t1) / (sigma * sqrt(t1)))))
g2 = ((CND(eta * (hh - mu1 * t1) / (sigma * sqrt(t1))) - exp(2 *
mu1 * hh / sigma ^ 2) * CND(eta * (-hh - mu1 * t1) / (sigma
* sqrt(t1)))) - (CND(eta * (m - mu1 * t1) / (sigma *
sqrt(t1))) - exp(2 * mu1 * hh / sigma ^ 2) * CND(eta * (m -
2 * hh - mu1 * t1) / (sigma * sqrt(t1)))))
# Needed by Out Value:
part1 = (S * exp((b-r)*T2) * (1+v^2/(2*b)) * (CBND(
eta*(+m-mu2*t1)/(v*sqrt(t1)),
eta*(-K+mu2*T2)/(v*sqrt(T2)), -rho) - exp(2*mu2*hh/v^2) *
CBND( eta*(m-2*hh-mu2*t1)/(v*sqrt(t1)),
eta*(2*hh-K+mu2*T2)/(v*sqrt(T2)), -rho) ))
part2 = (- X * exp(-r*T2) * ( CBND( eta*(+m-mu1*t1)/(v*sqrt(t1)),
eta*(-K+mu1*T2)/(v*sqrt(T2)), -rho) - exp(2*mu1*hh/v^2) *
CBND( eta*(m-2*hh-mu1*t1)/(v*sqrt(t1)),
eta*(2*hh-K+mu1*T2)/(v*sqrt(T2)), -rho) ))
part3 = (-exp(-r*T2) * v^2/(2*b) * ( S*(S/X)^(-2*b/v^2) * CBND(
eta * (m + mu1 * t1) / (v * sqrt(t1)), eta * (-K - mu1 *
T2) / (v * sqrt(T2)), -rho) - H*(H/X)^(-2*b/v^2) * CBND(
eta*(m - 2 * hh + mu1 * t1) / (v * sqrt(t1)), eta * (2 *
hh - K - mu1 * T2) / (v * sqrt(T2)), -rho) ))
part4 = (S * exp((b-r)*T2) * ((1+v^2/(2 * b)) *
CND(eta*mu2*(T2-t1)/(v*sqrt(T2-t1))) +
exp(-b*(T2-t1))*(1-v^2/(2*b)) *
CND(eta*(-mu1*(T2-t1))/(v*sqrt(T2-t1))))*g1 -
exp(-r*T2)*X*g2)
# Calculate Out Value:
OutValue = eta * (part1 + part2 + part3 + part4)
# Option Price:
if (TypeFlag == "cuo" || TypeFlag == "pdo")
LookBarrier = OutValue
if (TypeFlag == "cui")
LookBarrier = (PTFixedStrikeLookbackOption("c", S, X, t1, T2, r, b,
sigma)@price - OutValue)
if (TypeFlag == "pdi")
LookBarrier = (PTFixedStrikeLookbackOption("p", S, X, t1, T2, r, b,
sigma)@price - OutValue)
# Parameters:
# TypeFlag = c("cuo", "cui", "pdo", "pdi"), S, X, H, time1, Time2,
# r, b, sigma
param = list()
param$TypeFlag = TypeFlag
param$S = S
param$X = X
param$H = H
param$time1 = time1
param$Time2 = Time2
param$r = r
param$b = b
param$sigma = sigma
# Add title and description:
if (is.null(title)) title = "Look Barrier Option"
if (is.null(description)) description = as.character(date())
# Return Value:
new("fOPTION",
call = match.call(),
parameters = param,
price = LookBarrier,
title = title,
description = description
)
}
# ------------------------------------------------------------------------------
DiscreteBarrierOption =
function(S, H, sigma, dt, title = NULL, description = NULL)
{ # A function implemented by Diethelm Wuertz
# Description:
# Discrete Barrier Options
# References:
# Haug, Chapter 2.10.
# FUNCTION:
# Compute:
DiscreteBarrier = NA
if (H > S) {
DiscreteBarrier = H * exp(0.5826 * sigma * sqrt(dt)) }
if (H < S) {
DiscreteBarrier = H * exp(-0.5826 * sigma * sqrt(dt)) }
# Parameters:
# S, H, sigma, dt
param = list()
param$S = S
param$H = H
param$sigma = sigma
param$dt = dt
# Add title and description:
if (is.null(title)) title = "Discrete Barrier Option"
if (is.null(description)) description = as.character(date())
# Return Value:
new("fOPTION",
call = match.call(),
parameters = param,
price = DiscreteBarrier,
title = title,
description = description
)
}
# ------------------------------------------------------------------------------
SoftBarrierOption =
function(TypeFlag = c("cdi", "cdo", "pdi", "pdo"), S, X, L, U, Time ,
r, b, sigma, title = NULL, description = NULL)
{ # A function implemented by Diethelm Wuertz
# Description:
# Soft Barrier Option
# References:
# Haug, Haug Chapter 2.10.8
# FUNCTION:
# Compute:
TypeFlag = TypeFlag[1]
v = sigma
# Make Decisions - Settings:
if (TypeFlag == "cdi" || TypeFlag == "cdo") {
eta = 1}
else {
eta = -1 }
# Continue:
mu = (b + v ^ 2 / 2) / v ^ 2
lambda1 = exp(-1 / 2 * v ^ 2 * Time * (mu + 0.5) * (mu - 0.5))
lambda2 = exp(-1 / 2 * v ^ 2 * Time * (mu - 0.5) * (mu - 1.5))
d1 = log(U ^ 2 / (S * X)) / (v * sqrt(Time)) + mu * v * sqrt(Time)
d2 = d1 - (mu + 0.5) * v * sqrt(Time)
d3 = log(U ^ 2 / (S * X)) / (v * sqrt(Time)) + (mu - 1) * v * sqrt(Time)
d4 = d3 - (mu - 0.5) * v * sqrt(Time)
e1 = log(L ^ 2 / (S * X)) / (v * sqrt(Time)) + mu * v * sqrt(Time)
e2 = e1 - (mu + 0.5) * v * sqrt(Time)
e3 = log(L ^ 2 / (S * X)) / (v * sqrt(Time)) + (mu - 1) * v * sqrt(Time)
e4 = e3 - (mu - 0.5) * v * sqrt(Time)
# Compute Value:
Value = (eta * 1 / (U - L) * (S * exp((b - r) * Time) * S ^ (-2 *
mu) * (S * X) ^ (mu + 0.5) / (2 * (mu + 0.5)) * ((U ^ 2 /
(S * X)) ^ (mu + 0.5) * CND(eta * d1) - lambda1 * CND(eta
* d2) - (L ^ 2 / (S * X)) ^ (mu + 0.5) * CND(eta * e1) +
lambda1 * CND(eta * e2)) - X * exp(-r * Time) * S ^ (-2 *
(mu - 1)) * (S * X) ^ (mu - 0.5) / (2 * (mu - 0.5)) * ((U
^ 2 / (S * X)) ^ (mu - 0.5) * CND(eta * d3) - lambda2 *
CND(eta * d4) - (L ^ 2 / (S * X)) ^ (mu - 0.5) * CND(eta
* e3) + lambda2 * CND(eta * e4))))
### print(Value)
# Continue:
if (TypeFlag == "cdi" || TypeFlag == "pui") {
SoftBarrier = Value }
if (TypeFlag == "cdo") {
SoftBarrier = GBSOption("c", S, X, Time, r, b, v)@price - Value }
if (TypeFlag == "puo") {
SoftBarrier = GBSOption("p", S, X, Time, r, b, v)@price - Value }
# Parameters:
# TypeFlag = c("cdi", "cdo", "pdi", "pdo"), S, X, L, U, Time ,
# r, b, sigma
param = list()
param$TypeFlag = TypeFlag
param$S = S
param$X = X
param$L = L
param$U = U
param$Time = Time
param$r = r
param$b = b
param$sigma = sigma
# Add title and description:
if (is.null(title)) title = "Soft Barrier Option"
if (is.null(description)) description = as.character(date())
# Return Value:
new("fOPTION",
call = match.call(),
parameters = param,
price = SoftBarrier,
title = title,
description = description
)
}
################################################################################
fExoticOptions/R/CurrencyTranslatedOptions.R 0000644 0001762 0000144 00000016754 12323220016 020747 0 ustar ligges users
# This library is free software; you can redistribute it and/or
# modify it under the terms of the GNU Library General Public
# License as published by the Free Software Foundation; either
# version 2 of the License, or (at your option) any later version.
#
# This library is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU Library General Public License for more details.
#
# You should have received a copy of the GNU Library General
# Public License along with this library; if not, write to the
# Free Foundation, Inc., 59 Temple Place, Suite 330, Boston,
# MA 02111-1307 USA
################################################################################
# FUNCTION: DESCRIPTION:
# Currency Translated Options:
# FEInDomesticFXOption FX In Domestic Currency
# QuantoOption Quanto Option
# EquityLinkedFXOption EquityLinked FX Option
# TakeoverFXOption Takeover FX Option
################################################################################
FEInDomesticFXOption =
function(TypeFlag = c("c", "p"), S, E, X, Time, r, q, sigmaS, sigmaE, rho,
title = NULL, description = NULL)
{ # A function implemented by Diethelm Wuertz
# Description:
# Foreign equity option struck in domestic currency
# References:
# Haug, Chapter 2.13.1
# FUNCTION:
# Compute Settings:
TypeFlag = TypeFlag[1]
sigma = sqrt(sigmaE^2 + sigmaS^2 + 2*rho*sigmaE*sigmaS)
d1 = (log(E*S/X) + (r-q+sigma^2/2) * Time) / (sigma*sqrt(Time))
d2 = d1 - sigma * sqrt(Time)
# Calculate Call and Put:
if (TypeFlag == "c") {
ForeignEquityInDomesticFX = (E * S * exp(-q*Time)*CND(d1) -
X * exp(-r*Time)*CND(d2)) }
if (TypeFlag == "p") {
ForeignEquityInDomesticFX = (X * exp(-r*Time)*CND(-d2) -
E * S * exp(-q*Time)*CND(-d1)) }
# Parameters:
# TypeFlag = c("c", "p"), S, E, X, Time, r, q, sigmaS, sigmaE, rho
param = list()
param$TypeFlag = TypeFlag
param$S = S
param$E = E
param$X = X
param$Time = Time
param$r = r
param$q = q
param$sigmaS = sigmaS
param$sigmaE = sigmaE
param$rho = rho
# Add title and description:
if (is.null(title)) title = "FE In Domestic FX Option"
if (is.null(description)) description = as.character(date())
# Return Value:
new("fOPTION",
call = match.call(),
parameters = param,
price = ForeignEquityInDomesticFX,
title = title,
description = description
)
}
# ------------------------------------------------------------------------------
QuantoOption =
function(TypeFlag = c("c", "p"), S, Ep, X, Time, r, rf, q, sigmaS,
sigmaE, rho, title = NULL, description = NULL)
{ # A function implemented by Diethelm Wuertz
# Description:
# Fixed exchange rate foreign equity options
# References:
# Haug, Chapter 2.13.2
# FUNCTION:
# Compute Settings:
TypeFlag = TypeFlag[1]
d1 = ((log(S/X) + (rf-q-rho*sigmaS*sigmaE + sigmaS^2/2) * Time) /
(sigmaS*sqrt(Time)))
d2 = d1 - sigmaS*sqrt (Time)
# Calculate Call and Put:
if (TypeFlag == "c") {
Quanto = (Ep*(S*exp((rf-r-q-rho*sigmaS*sigmaE)*Time) *
CND(d1) - X*exp(-r*Time)*CND(d2))) }
if (TypeFlag == "p") {
Quanto = (Ep*(X*exp(-r*Time)*CND(-d2) -
S*exp((rf-r-q-rho*sigmaS*sigmaE)* Time)*CND(-d1))) }
# Parameters:
# TypeFlag = c("c", "p"), S, Ep, X, Time, r, rf, q, sigmaS, sigmaE, rho
param = list()
param$TypeFlag = TypeFlag
param$S = S
param$Ep = Ep
param$X = X
param$Time = Time
param$r = r
param$rf = rf
param$q = q
param$sigmaS = sigmaS
param$sigmaE = sigmaE
param$rho = rho
# Add title and description:
if (is.null(title)) title = "Quanto Option"
if (is.null(description)) description = as.character(date())
# Return Value:
new("fOPTION",
call = match.call(),
parameters = param,
price = Quanto,
title = title,
description = description
)
}
# ------------------------------------------------------------------------------
EquityLinkedFXOption =
function(TypeFlag = c("c", "p"), E, S, X, Time, r, rf, q, sigmaS,
sigmaE, rho, title = NULL, description = NULL)
{ # A function implemented by Diethelm Wuertz
# Description:
# Equity Linked FX Option -
# References:
# Haug, Chapter 2.13.3
# FUNCTION:
# Compute Settings:
TypeFlag = TypeFlag[1]
vS = sigmaS
vE = sigmaE
d1 = ((log(E / X) + (r - rf + rho * vS * vE + vE ^ 2 / 2) * Time) /
(vE * sqrt(Time)))
d2 = d1 - vE * sqrt(Time)
# Calculate Call and Put:
if (TypeFlag == "c") {
EquityLinkedFXO = (E * S * exp(-q * Time) * CND(d1) -
X * S * exp((rf - r - q - rho * vS * vE) * Time) *
CND(d2)) }
if (TypeFlag == "p") {
EquityLinkedFXO = (X * S * exp((rf - r - q - rho * vS * vE) * Time) *
CND(-d2) - E * S * exp(-q * Time) * CND(-d1)) }
# Parameters:
# TypeFlag = c("c", "p"), E, S, X, Time, r, rf, q, sigmaS, sigmaE, rho
param = list()
param$TypeFlag = TypeFlag
param$E = E
param$S = S
param$X = X
param$Time = Time
param$r = r
param$rf = rf
param$q = q
param$sigmaS = sigmaS
param$sigmaE = sigmaE
param$rho = rho
# Add title and description:
if (is.null(title)) title = "Equity Linked FX Option"
if (is.null(description)) description = as.character(date())
# Return Value:
new("fOPTION",
call = match.call(),
parameters = param,
price = EquityLinkedFXO,
title = title,
description = description
)
}
# ------------------------------------------------------------------------------
TakeoverFXOption =
function(V, B, E, X, Time, r, rf, sigmaV, sigmaE, rho,
title = NULL, description = NULL)
{ # A function implemented by Diethelm Wuertz
# Description:
# Takeover FX Option -
# References:
# Haug, Chapter 2.13.4
# FUNCTION:
# Compute Settings:
v = V
b = B
vV = sigmaV
vE = sigmaE
a1 = ((log(v / b) + (rf - rho * vE * vV - vV ^ 2 / 2) * Time) /
(vV * sqrt(Time)))
a2 = ((log(E / X) + (r - rf - vE ^ 2 / 2) * Time) /
(vE * sqrt(Time)))
# Calculate:
TakeoverFX = (b * (E * exp(-rf * Time) * CBND(a2 + vE *
sqrt(Time), -a1 - rho * vE * sqrt(Time), -rho) - X *
exp(-r * Time) * CBND(-a1, a2, -rho)))
# Parameters:
# V, B, E, X, Time, r, rf, sigmaV, sigmaE, rho
param = list()
param$V = V
param$B = B
param$E = E
param$X = X
param$Time = Time
param$r = r
param$rf = rf
param$q = q
param$sigmaV = sigmaV
param$sigmaE = sigmaE
param$rho = rho
# Add title and description:
if (is.null(title)) title = "Takeover FX Option"
if (is.null(description)) description = as.character(date())
# Return Value:
new("fOPTION",
call = match.call(),
parameters = param,
price = TakeoverFX,
title = title,
description = description
)
}
################################################################################
fExoticOptions/R/zzz.R 0000644 0001762 0000144 00000003624 13202327202 014406 0 ustar ligges users
# This library is free software; you can redistribute it and/or
# modify it under the terms of the GNU Library General Public
# License as published by the Free Software Foundation; either
# version 2 of the License, or (at your option) any later version.
#
# This library is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU Library General Public License for more details.
#
# You should have received a copy of the GNU Library General
# Public License along with this library; if not, write to the
# Free Foundation, Inc., 59 Temple Place, Suite 330, Boston,
# MA 02111-1307 USA
###############################################################################
.onAttach <-
function(libname, pkgname)
{
# do whatever needs to be done when the package is loaded
# some people use it to bombard users with
# messages using
# packageStartupMessage( "\n" )
# packageStartupMessage( "Rmetrics Package fExoticOptions" )
# packageStartupMessage( "Pricing and Evaluating Exotic Options" )
# packageStartupMessage( "Copyright (C) 2005-2014 Rmetrics Association Zurich" )
# packageStartupMessage( "Educational Software for Financial Engineering and Computational Science" )
# packageStartupMessage( "Rmetrics is free software and comes with ABSOLUTELY NO WARRANTY." )
# packageStartupMessage( "https://www.rmetrics.org --- Mail to: info@rmetrics.org" )
# # packageStartupMessage("Documentation: www.rmetrics.org/ebooks-portfolio" )
# # packageStartupMessage("Rmetrics User/Developer Workshop and Summer School 2012\n" )
# # packageStartupMessage(" June 24-28, 2012 - Meielisalp, Lake Thune, Switzerland\n\n" )
}
###############################################################################
fExoticOptions/MD5 0000644 0001762 0000144 00000003324 13203517731 013543 0 ustar ligges users 54e54ea458dc354636fa38d33cd4dbf2 *ChangeLog
115a4935cfb165a6006e214437537c6e *DESCRIPTION
80ffa69fe5d3e980d17d078e7913c0a2 *NAMESPACE
7b55d49b1967b455d4e17d8e45cef0cd *R/AsianOptions.R
269864eb5b217bb46760b9ff45c30d0b *R/BarrierOptions.R
406ad4840a5e22083d8aac179fca2f96 *R/BinaryOptions.R
de7f3b9faf9eaffa40a968b5c3aae790 *R/CurrencyTranslatedOptions.R
2158a6e0f131141f2095e885a5ae37ff *R/LookbackOptions.R
141e7aa562e5a05f12463227441d1b0e *R/MultipleAssetsOptions.R
229a963b95af17182c6de46088f84d54 *R/MultipleExercisesOptions.R
bcb8a9ea7b73ae5d5609f34b4cf23a36 *R/zzz.R
6042b9c5e5bec3ecc1b6959cd2858b64 *inst/COPYRIGHT.html
e3426432ec17e71a562e7c2fb6ad3952 *inst/unitTests/Makefile
832ba294e302210649e3583353d42aad *inst/unitTests/runTests.R
8fd8cc28da7a07a3bf252bcd62d70864 *inst/unitTests/runit.BarrierOptions.R
6f7eeeef9191687fb28e854d0ae0d82d *inst/unitTests/runit.BasicAsianOptions.R
0308ca175977b64944b0db427897e0d7 *inst/unitTests/runit.BinaryOptions.R
e715e6e485a70ba05a56370e09ace638 *inst/unitTests/runit.CurrencyTranslatedOptions.R
b5d8c8ea68f7144bfbcdbe3ea30cc7bc *inst/unitTests/runit.LookbackOptions.R
34c833f2ad04cfe5b52b0353e854dbd0 *inst/unitTests/runit.MultipleAssetsOptions.R
eeaeaa1dc8d9c335570b9fc41bef9565 *inst/unitTests/runit.MultipleExercisesOptions.R
896dc4c9f474490743316a6049376112 *man/AsianOptions.Rd
2695f9a435902f8f6abd4f449fda3d4d *man/BarrierOptions.Rd
80f720f1708bc3d278a04a78aafe1dd5 *man/BinaryOptions.Rd
216d6c1361f7030096a1c30d65ec45b1 *man/CurrencyTranslatedOptions.Rd
6950820a2b96ff5cd7ad13a96918d573 *man/LookbackOptions.Rd
93daf7958fbbc2ef5cabeb5a8a8fae88 *man/MultipleAssetsOptions.Rd
fc1731972ed28383da8c51b68d9980d7 *man/MultipleExercisesOptions.Rd
ef403f4a0c28ad8a7edab4995227a9d2 *tests/doRUnit.R
fExoticOptions/DESCRIPTION 0000644 0001762 0000144 00000001311 13203517731 014733 0 ustar ligges users Package: fExoticOptions
Title: Rmetrics - Pricing and Evaluating Exotic Option
Date: 2017-11-12
Version: 3042.80
Author: Diethelm Wuertz [aut],
Tobias Setz [cre]
Maintainer: Tobias Setz
Description: Provides a collection of functions to evaluate
barrier options, Asian options, binary options, currency
translated options, lookback options, multiple asset options
and multiple exercise options.
Depends: R (>= 2.15.1), timeDate, timeSeries, fBasics, fOptions
Imports: methods
Suggests: RUnit
LazyData: yes
License: GPL (>= 2)
URL: http://www.rmetrics.org
NeedsCompilation: no
Packaged: 2017-11-17 06:21:12 UTC; Tobias Setz
Repository: CRAN
Date/Publication: 2017-11-17 08:37:45 UTC
fExoticOptions/ChangeLog 0000644 0001762 0000144 00000002177 12270460532 015011 0 ustar ligges users
20140-01-24 wuertz
* DESCRPION: version number and title updated
2012-11-07 chalabi
* DESCRIPTION: Updated version number and maintainer field
* NAMESPACE: Added NAMESPACE
* DESCRIPTION: Updated maintainer field to comply new CRAN policy
2011-09-23 mmaechler
* DESCRIPTION: remove deprecated "LazyLoad" entry
2010-07-23 chalabi
* inst/DocCopying.pdf: removed DocCopying.pdf license is already
specified in DESCRIPTION file
2009-11-09 chalabi
* DESCRIPTION: updated version number
2009-11-05 chalabi
* ChangeLog, DESCRIPTION: updated ChangeLog and DESCRIPTION
2009-11-03 chalabi
* R/AsianOptions.R, R/BarrierOptions.R, R/BinaryOptions.R,
R/CurrencyTranslatedOptions.R, R/LookbackOptions.R,
R/MultipleAssetsOptions.R, R/MultipleExercisesOptions.R: Fixed
wrong split of commands.
* R/zzz.R: Removed message on startup.
2009-09-30 chalabi
* DESCRIPTION: updated version number
2009-09-29 chalabi
* ChangeLog, DESCRIPTION: updated DESC and ChangeLog
2009-04-02 chalabi
* DESCRIPTION: more explicit depends and suggests field in DESC
file.
2009-04-01 chalabi
* DESCRIPTION: updated DESC file
fExoticOptions/man/ 0000755 0001762 0000144 00000000000 13203477730 014010 5 ustar ligges users fExoticOptions/man/BinaryOptions.Rd 0000644 0001762 0000144 00000037153 11645005270 017102 0 ustar ligges users \name{BinaryOptions}
\alias{BinaryOptions}
\alias{GapOption}
\alias{CashOrNothingOption}
\alias{TwoAssetCashOrNothingOption}
\alias{AssetOrNothingOption}
\alias{SuperShareOption}
\alias{BinaryBarrierOption}
\title{Valuation of Binary Options}
\description{
A collection and description of functions to valuate
binary options. Binary options, also known as digital
options, have discontinuous payoffs. They can be used
as building blocks to develop options with more
complicated payoffs. For example, a regular European
call option is equivalent to a long position in an
asset-or-nothing call and a short position in a
cash-or-nothing call, where the both options have the
same strike price and the cash payoff of the
cash-or-nothing option equals the strike price. Unlike
standard European style options, the payout for binary
options does not depend on how much it is in-the-money
but rather whether or not it is on the money. The option's
payoff is fixed at the options inception and is based
on the price of the underlying asset on the expiration
date. Binary options may also incorporate barriers,
as is the case with binary-barrier options.
\cr
The functions are:
\tabular{ll}{
\code{GapOption} \tab Gap Option, \cr
\code{CashOrNothingOption} \tab Cash Or Nothing Option, \cr
\code{TwoAssetCashOrNothingOption} \tab Two Asset Cash Or Nothing Option, \cr
\code{AssetOrNothingOption} \tab Asset Or Nothing Option, \cr
\code{SuperShareOption} \tab Super Share Option, \cr
\code{BinaryBarrierOption} \tab Binary Barrier Option. }
}
\usage{
GapOption(TypeFlag, S, X1, X2, Time, r, b, sigma, title = NULL,
description = NULL)
CashOrNothingOption(TypeFlag, S, X, K, Time, r, b, sigma,
title = NULL, description = NULL)
TwoAssetCashOrNothingOption(TypeFlag, S1, S2, X1, X2, K, Time, r,
b1, b2, sigma1, sigma2, rho, title = NULL, description = NULL)
AssetOrNothingOption(TypeFlag, S, X, Time, r, b, sigma,
title = NULL, description = NULL)
SuperShareOption(S, XL, XH, Time, r, b, sigma, title = NULL,
description = NULL)
BinaryBarrierOption(TypeFlag, S, X, H, K, Time, r, b, sigma,
eta, phi, title = NULL, description = NULL)
}
\arguments{
\item{b}{
the annualized cost-of-carry rate, a numeric value;
e.g. 0.1 means 10\% pa.
}
\item{b1, b2}{
[TwoAssetCashOrNothing*] - \cr
the annualized cost-of-carry rate for the first and second
asset, a numeric value.
}
\item{description}{
a character string which allows for a brief description.
}
\item{eta, phi}{
[BinaryBarrier*] - \cr
a set of parameters to price 28 different types of Binary
Barrier options:\cr
01: \code{eta=+1, phi=NA, [S>H]} down-and-in cash-at-hit-or-nothing, \cr
02: \code{eta=-1, phi=NA, [SH]} down-and-in asset-at-hit-or-nothing, \cr
04: \code{eta=-1, phi=NA, [SH]} down-and-in cash-at-expiry-or-nothing, \cr
06: \code{eta=-1, phi=+1, [SH]} down-and-in asset-at-expiry-or-nothing, \cr
08: \code{eta=-1, phi=+1, [SH]} down-and-out cash-or-nothing, \cr
10: \code{eta=-1, phi=-1, [SH]} down-and-out asset-or-nothing, \cr
12: \code{eta=-1, phi=-1, [SH]} down-and-in cash-or-nothing call, \cr
14: \code{eta=-1, phi=+1, [SH]} down-and-in asset-or-nothing call, \cr
16: \code{eta=-1, phi=+1, [SH]} down-and-in cash-or-nothing put, \cr
18: \code{eta=-1, phi=-1, [SH]} down-and-in asset-or-nothing put, \cr
20: \code{eta=-1, phi=-1, [SH]} down-and-out cash-or-nothing call, \cr
22: \code{eta=-1, phi=+1, [SH]} down-and-out asset-or-nothing call, \cr
24: \code{eta=-1, phi=-1, [SH]} down-and-out cash-or-nothing put, \cr
26: \code{eta=-1, phi=-1, [SH]} down-and-out asset-or-nothing put, \cr
28: \code{eta=-1, phi=-1, [S