fOptions/0000755000175100001440000000000012620144160012065 5ustar hornikusersfOptions/inst/0000755000175100001440000000000012620131167013045 5ustar hornikusersfOptions/inst/COPYRIGHT.html0000644000175100001440000002041112620131167015301 0ustar hornikusers 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
fOptions/inst/unitTests/0000755000175100001440000000000012620131167015047 5ustar hornikusersfOptions/inst/unitTests/Makefile0000644000175100001440000000042112620131167016504 0ustar hornikusersPKG=fOptions 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} fOptions/inst/unitTests/runit.BasicAmericanOptions.R0000644000175100001440000000661012620131167022372 0ustar hornikusers # 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: DESCRIPTION: # RollGeskeWhaleyOption Roll-Geske-Whaley Calls on Dividend Paying Stocks # BAWAmericanApproxOption Barone-Adesi and Whaley Approximation # BSAmericanApproxOption Bjerksund and Stensland Approximation ################################################################################ test.RollGeskeWhaleyOption = function() { # RollGeskeWhaleyOption # Roll-Geske-Whaley Calls on Dividend Paying Stocks # Arguments: # RollGeskeWhaleyOption(S, X, time1, Time2, r, D, sigma, # title = NULL, description = NULL) # Roll-Geske-Whaley American Calls on Dividend Paying # Stocks [Haug 1.4.1] RollGeskeWhaleyOption(S = 80, X = 82, time1 = 1/4, Time2 = 1/3, r = 0.06, D = 4, sigma = 0.30) # Return Value: return() } # ------------------------------------------------------------------------------ test.BAWAmericanApproxOption = function() { # BAWAmericanApproxOption # Barone-Adesi and Whaley Approximation # Arguments: # BAWAmericanApproxOption(TypeFlag = c("c", "p"), S, X, Time, r, b, # sigma, title = NULL, description = NULL) # Barone-Adesi and Whaley Approximation for American # Options [Haug 1.4.2] vs. Black76 Option on Futures: BAWAmericanApproxOption(TypeFlag = "p", S = 100, X = 100, Time = 0.5, r = 0.10, b = 0, sigma = 0.25) Black76Option(TypeFlag = "c", FT = 100, X = 100, Time = 0.5, r = 0.10, sigma = 0.25) # Return Value: return() } # ------------------------------------------------------------------------------ test.BSAmericanApproxOption = function() { # BSAmericanApproxOption # Bjerksund and Stensland Approximation # Arguments: # BSAmericanApproxOption(TypeFlag = c("c", "p"), S, X, Time, r, b, # sigma, title = NULL, description = NULL) # Bjerksund and Stensland Approximation for American Options: BSAmericanApproxOption(TypeFlag = "c", S = 42, X = 40, Time = 0.75, r = 0.04, b = 0.04-0.08, sigma = 0.35) # Return Value: return() } ################################################################################ fOptions/inst/unitTests/runit.PlainVanillaOptions.R0000644000175100001440000003150112620131167022260 0ustar hornikusers # 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: DESCRIPTION: # 'fOPTION' S4 Class Representation # FUNCTION: DESCRIPTION: # NDF Normal distribution function # CND Cumulative normal distribution function # CBND Cumulative bivariate normal distribution # FUNCTION: DESCRIPTION: # GBSOption Computes Option Price from the GBS Formula # GBSCharacteristics Computes Option Price and all Greeks of GBS Model # BlackScholesOption Synonyme Function Call to GBSOption # GBSGreeks Computes one of the Greeks of the GBS formula # FUNCTION: DESCRIPTION: # Black76Option Computes Prices of Options on Futures # MiltersenSchwartzOption Pricing a Miltersen Schwartz Option # S3 METHODS: DESCRIPTION: # print.option Print Method # summary.otion Summary Method ################################################################################ test.NDF = function() { # NDF: # Normal distribution function # Arguments: # NDF(x) # NDF: x = (-3):3 NDF(x) dnorm(x) NDF(x)-dnorm(x) # Return Value: return() } # ------------------------------------------------------------------------------ test.CND = function() { # CND: # Cumulative normal distribution function # Arguments: # CND(x) # CND: # NDF: x = (-3):3 CND(x) pnorm(x) CND(x)-pnorm(x) # Return Value: return() } # ------------------------------------------------------------------------------ test.CBND = function() { # CBND: # Cumulative bivariate normal distribution # Arguments: # CBND(x1, x2, rho) # CBND: CBND(0, 0, 1/2) # Return Value: return() } # ------------------------------------------------------------------------------ test.GBSOption = function() { # GBSOption: # Computes Option Price from the GBS Formula # Arguments: # GBSOption(TypeFlag = c("c", "p"), S, X, Time, r, b, sigma, # title = NULL, description = NULL) # GBSOption: GBSOption("c", 100, 100, 1, 0.10, 0.10, 0.30) # Return Value: return() } # ------------------------------------------------------------------------------ test.GBSCharacteristics = function() { # GBSCharacteristics: # Computes Option Price and all Greeks of GBS Model # Arguments: # GBSCharacteristics(TypeFlag = c("c", "p"), S, X, Time, r, b, sigma) # GBSCharacteristics: GBSCharacteristics("c", 100, 100, 1, 0.10, 0.10, 0.30) # Return Value: return() } # ------------------------------------------------------------------------------ test.BlackScholesOption = function() { # BlackScholesOption: # Synonyme Function Call to GBSOption # Arguments: # BlackScholesOption(...) # Return Value: return() } # ------------------------------------------------------------------------------ test.Black76Option = function() { # Black76Option # Computes Prices of Options on Futures # Arguments: # Black76Option = (TypeFlag = c("c", "p"), FT, X, Time, r, sigma, # title = NULL, description = NULL) # Black76Option: Black76Option(FT = 95, X = 80, Time = 1/2, r = 0.05, sigma = 0.266) # Return Value: return() } # ------------------------------------------------------------------------------ test.MiltersenSchwartzOption = function() { # MiltersenSchwartzOption # Pricing a Miltersen Schwartz Option # Arguments: # MiltersenSchwartzOption(TypeFlag = c("c", "p"), Pt, FT, X, time, Time, # sigmaS, sigmaE, sigmaF, rhoSE, rhoSF, rhoEF, KappaE, KappaF, # title = NULL, description = NULL) # MiltersenSchwartzOption: MiltersenSchwartzOption(TypeFlag = "c", Pt = exp(-0.05/4), FT = 95, X = 80, time = 1/4, Time = 1/2, sigmaS = 0.2660, sigmaE = 0.2490, sigmaF = 0.0096, rhoSE = 0.805, rhoSF = 0.0805, rhoEF = 0.1243, KappaE = 1.045, KappaF = 0.200) # Return Value: return() } # ------------------------------------------------------------------------------ test.print = function() { # GBSOption(TypeFlag = c("c", "p"), S, X, Time, r, b, sigma, # title = NULL, description = NULL) GBS = GBSOption("c", 100, 100, 1, 0.10, 0.10, 0.30) # Print Method: show(GBS) print(GBS) # Summary Method: summary(GBS) # Return Value: return() } # ------------------------------------------------------------------------------ test.GBSOptionSlider = function() { .GBSOptionSlider = function(TypeFlag = "c", S = 100, X = 100, Time = 1, r = 0.10, b = 0.10, sigma = 0.25, span = 0.25, N = 40) { # Internal Function: refresh.code = function(...) { # Sliders: S = .sliderMenu(no = 1) X = .sliderMenu(no = 2) Time = .sliderMenu(no = 3) sigma = .sliderMenu(no = 4) r = .sliderMenu(no = 5) b = .sliderMenu(no = 6) theta = .sliderMenu(no = 7) phi = .sliderMenu(no = 8) TypeFlagText = c(c = "Call:", p = "Put:") if (r != rNow | b != bNow) { for (j in 1:nY) z[j, ] <<- GBSOption(TypeFlag, sOption, xOption, timeOption[j], r = rNow, b = bNow, sigmaOption)@price rNow <<- r bNow <<- b } persp(x, y, z, theta = theta, phi = phi, ticktype = "detailed", col = "steelblue", shade = 0.5, border = TRUE) -> Option ZZ = GBSOption(TypeFlag, S, X, Time, r=rNow, b=bNow, sigma)@price XX <<- sigma^2*Time YY <<- S/X points(trans3d(XX, YY, ZZ, pm = Option), pch = 19, col = "orange") title(main = paste( TypeFlagText[TypeFlag], as.character(signif(ZZ, 5)))) mS = signif(S, 3) mX = signif(X, 3) mSigma = round(sigma, digits = 2) mTime = round(Time, digits = 2) mText = paste( "S =", mS, "| X =", mX, "| Time =", mTime, "| sigma =", mSigma) mtext(mText) } # Initialization: TypeFlag <<- TypeFlag rNow <<- r bNow <<- b N <<- N Smin = S*(1-span) Smax = S*(1+span) Sres = (Smax-Smin)/N Son = (Smin+Smax)/2 Xmin = X*(1-span) Xmax = X*(1+span) Xres = (Xmax-Xmin)/N Xon = (Xmin+Xmax)/2 sOption <<- seq(Smin, Smax, by = Sres) xOption <<- Xon nX <<- length(sOption) timeOption <<- seq(1e-6, 3, length = N) sigmaOption <<- 0.25 nY <<- length(timeOption) z <<- matrix(rep(0, nX*nY), ncol = nX) for (j in 1:nY) z[j, ] <<- GBSOption(TypeFlag, sOption, xOption, timeOption[j], r = rNow, b = bNow, sigmaOption)@price x <<- sigmaOption^2*timeOption y <<- sOption/xOption # Open Slider Menu: plot.names = c("Plot - theta", "... phi") .sliderMenu(refresh.code, names = c( "S", "X", "Time", "sigma", "r", "b", plot.names), minima = c(Smin, Xmin, 1e-6, 0.005, 0.01, 0.01, -180, 0), maxima = c(Smax, Xmax, 3.00, 0.500, 0.20, 0.20, 180, 360), resolutions = c(Sres, Xres, 0.10, 0.005, 0.01, 0.01, 2, 2), starts = c( Son, Xon, 1.00, 0.250, 0.10, 0.10, -40, 30)) } # Try: # .GBSOptionSlider("p") # Return Value: return() } # ------------------------------------------------------------------------------ test.GBSGreeksSlider = function() { .GBSGreeksSlider = function(TypeFlag = "c", S = 100, X = 100, Time = 1, r = 0.10, b = 0.10, sigma = 0.25, span = 0.25, N = 40) { # Internal Function: refresh.code = function(...) { # Sliders: S = .sliderMenu(no = 1) X = .sliderMenu(no = 2) Time = .sliderMenu(no = 3) sigma = .sliderMenu(no = 4) r = .sliderMenu(no = 5) b = .sliderMenu(no = 6) theta = .sliderMenu(no = 7) phi = .sliderMenu(no = 8) Selection = "Gamma" TypeFlagText = c(c = "Call:", p = "Put:") if (r != rNow | b != bNow) { for (j in 1:nY) z[j, ] <<- GBSGreeks(Selection, TypeFlag, sOption, xOption, timeOption[j], r = rNow, b = bNow, sigmaOption) rNow <<- r bNow <<- b } persp(x, y, z, theta = theta, phi = phi, ticktype = "detailed", col = "steelblue", shade = 0.5, border = TRUE) -> Option ZZ = GBSGreeks(Selection, TypeFlag, S, X, Time, r = rNow, b = bNow, sigma) XX <<- sigma^2*Time YY <<- S/X points(trans3d(XX, YY, ZZ, pm = Option), pch = 19, col = "orange") title(main = paste( TypeFlagText[TypeFlag], as.character(signif(ZZ, 5)))) mS = signif(S, 3) mX = signif(X, 3) mSigma = round(sigma, digits = 2) mTime = round(Time, digits = 2) mText = paste( "S =", mS, "| X =", mX, "| Time =", mTime, "| sigma =", mSigma) mtext(mText) } # Initialization: TypeFlag <<- TypeFlag rNow <<- r bNow <<- b N <<- N Smin = S*(1-span) Smax = S*(1+span) Sres = (Smax-Smin)/N Son = (Smin+Smax)/2 Xmin = X*(1-span) Xmax = X*(1+span) Xres = (Xmax-Xmin)/N Xon = (Xmin+Xmax)/2 sOption <<- seq(Smin, Smax, by = Sres) xOption <<- Xon nX <<- length(sOption) timeOption <<- seq(0, 3, length = N+1)[-1] sigmaOption <<- 0.25 nY <<- length(timeOption) z <<- matrix(rep(0, nX*nY), ncol = nX) for (j in 1:nY) z[j, ] <<- GBSGreeks("Gamma", TypeFlag, sOption, xOption, timeOption[j], r = rNow, b = bNow, sigmaOption) x <<- sigmaOption^2*timeOption y <<- sOption/xOption # Open Slider Menu: plot.names = c("Plot - theta", "... phi") .sliderMenu(refresh.code, names = c( "S", "X", "Time", "sigma", "r", "b", plot.names), minima = c(Smin, Xmin, 1e-6, 0.005, 0.01, 0.01, -180, 0), maxima = c(Smax, Xmax, 3.00, 0.500, 0.20, 0.20, 180, 360), resolutions = c(Sres, Xres, 0.10, 0.005, 0.01, 0.01, 2, 2), starts = c( Son, Xon, 1.00, 0.250, 0.10, 0.10, -40, 30)) } # Try # .GBSGreeksSlider("c") # Return Value: return() } ################################################################################ fOptions/inst/unitTests/runit.HestonnandiGarchOption.R0000644000175100001440000001023412620131167022742 0ustar hornikusers # 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: DESCRIPTION: # HNGOption Computes Option Price from the HN-GARCH Formula # HNGGreeks Calculates one of the Greeks of the HN-GARCH Formula # HNGCharacteristics Computes Option Price and all Greeks of HN-GARCH Model ################################################################################ test.HNGOption = function() { # HNGOption - Computes Option Price from the HN-GARCH Formula # Define the Model Parameters for a Heston-Nandi Option: model = list(lambda = -0.5, omega = 2.3e-6, alpha = 2.9e-6, beta = 0.85, gamma = 184.25) S = X = 100 Time.inDays = 252 r.daily = 0.05/Time.inDays sigma.daily = sqrt((model$omega + model$alpha) / (1 - model$beta - model$alpha * model$gamma^2)) data.frame(S, X, r.daily, sigma.daily) # HNGOption: # Compute HNG Call-Put and compare with GBS Call-Put: HNG = GBS = Diff = NULL for (TypeFlag in c("c", "p")) { HNG = c(HNG, HNGOption(TypeFlag, model = model, S = S, X = X, Time.inDays = Time.inDays, r.daily = r.daily)$price ) GBS = c(GBS, GBSOption(TypeFlag, S = S, X = X, Time = Time.inDays, r = r.daily, b = r.daily, sigma = sigma.daily)@price) } Options = cbind(HNG, GBS, Diff = round(100*(HNG-GBS)/GBS, digits = 2)) row.names(Options) <- c("Call", "Put") data.frame(Options) # TODO: HNG not yet a S4 Class Member !!! # Return Value: return() } # ------------------------------------------------------------------------------ test.HNGGreeks = function() { # HNGGreeks - Calculates one of the Greeks of the HN-GARCH Formula # Define the Model Parameters for a Heston-Nandi Option: model = list(lambda = -0.5, omega = 2.3e-6, alpha = 2.9e-6, beta = 0.85, gamma = 184.25) S = X = 100 Time.inDays = 252 r.daily = 0.05/Time.inDays sigma.daily = sqrt((model$omega + model$alpha) / (1 - model$beta - model$alpha * model$gamma^2)) data.frame(S, X, r.daily, sigma.daily) # Compute HNG Greeks and compare with GBS Greeks: Selection = c("Delta", "Gamma") HNG = GBS = NULL for (i in 1:2){ HNG = c(HNG, HNGGreeks(Selection[i], TypeFlag = "c", model = model, S = 100, X = 100, Time = Time.inDays, r = r.daily)) GBS = c(GBS, GBSGreeks(Selection[i], TypeFlag = "c", S = 100, X = 100, Time = Time.inDays, r = r.daily, b = r.daily, sigma = sigma.daily)) } Greeks = cbind(HNG, GBS, Diff = round(100*(HNG-GBS)/GBS, digits = 2)) row.names(Greeks) <- Selection data.frame(Greeks) # Return Value: return() } # ------------------------------------------------------------------------------ test.HNGCharacteristics = function() { # HNGCharacteristics # Computes Option Price and all Greeks of HN-GARCH Model NA # Return Value: return() } ################################################################################ fOptions/inst/unitTests/runit.BinomialTreeOptions.R0000644000175100001440000000566412620131167022273 0ustar hornikusers # 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: DESCRIPTION: # CRRBinomialTreeOption Cox-Ross-Rubinstein Binomial Tree Option Model # JRBinomialTreeOption JR Modfication to the Binomial Tree Option # TIANBinomialTreeOption Tian's Modification to the Binomial Tree Option # FUNCTION: DESCRIPTION: # BinomialTreeOption CRR Binomial Tree Option with Cost of Carry Term # BinomialTreePlot Plots results from the CRR Option Pricing Model ################################################################################ test.CRRBinomialTreeOption = function() { # CRRBinomialTreeOption # Cox-Ross-Rubinstein Binomial Tree Option Model # Return Value: return() } # ------------------------------------------------------------------------------ test.JRBinomialTreeOption = function() { # JRBinomialTreeOption # JR Modfication to the Binomial Tree Option # Return Value: return() } # ------------------------------------------------------------------------------ test.TIANBinomialTreeOption = function() { # TIANBinomialTreeOption # Tian's Modification to the Binomial Tree Option # Return Value: return() } # ------------------------------------------------------------------------------ test.BinomialTreeOption = function() { # BinomialTreeOption # CRR Binomial Tree Option with Cost of Carry Term # Return Value: return() } # ------------------------------------------------------------------------------ test.BinomialTreePlot = function() { # BinomialTreePlot # Plots results from the CRR Option Pricing Model # Return Value: return() } ################################################################################ fOptions/inst/unitTests/runit.MonteCarloOptions.R0000644000175100001440000001106612620131167021755 0ustar hornikusers # 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: DESCRIPTION: # MonteCarloOption Valuate Options by Monte Carlo Simulation ################################################################################ test.MonteCarloOption <- function() { # How to perform a Monte Carlo Simulation? # RVs: RNGkind(kind = "Marsaglia-Multicarry", normal.kind = "Inversion") set.seed(4711, kind = "Marsaglia-Multicarry") # First Step: # Write a function to generate the option's innovations. # Use scrambled normal Sobol numbers: sobolInnovations = function(mcSteps, pathLength, init, ...) { # Create Normal Sobol Innovations: innovations = rnorm.sobol(mcSteps, pathLength, init, ...) # Return Value: innovations } # Second Step: # Write a function to generate the option's price paths. # Use a Wiener path: wienerPath = function(eps) { # Note, the option parameters must be globally defined! # Generate the Paths: path = (b-sigma*sigma/2)*delta.t + sigma*sqrt(delta.t)*eps # Return Value: path } # Third Step: # Write a function for the option's payoff # Example 1: use the payoff for a plain Vanilla Call or Put: plainVanillaPayoff = function(path) { # Note, the option parameters must be globally defined! # Compute the Call/Put Payoff Value: ST = S*exp(sum(path)) if (TypeFlag == "c") payoff = exp(-r*Time)*max(ST-X, 0) if (TypeFlag == "p") payoff = exp(-r*Time)*max(0, X-ST) # Return Value: payoff } # Example 2: use the payoff for an arithmetic Asian Call or Put: arithmeticAsianPayoff = function(path) { # Note, the option parameters must be globally defined! # Compute the Call/Put Payoff Value: SM = mean(S*exp(cumsum(path))) if (TypeFlag == "c") payoff = exp(-r*Time)*max(SM-X, 0) if (TypeFlag == "p") payoff = exp(-r*Time)*max(0, X-SM) # Return Value: payoff } # Final Step: # Set Global Parameters for the plain Vanilla / arithmetic Asian Options: TypeFlag <- "c"; S <- 100; X <- 100 Time <- 1/12; sigma <- 0.4; r <- 0.10; b <- 0.1 # Do the Asian Simulation with scrambled random numbers: mc = MonteCarloOption(delta.t = 1/360, pathLength = 30, mcSteps = 5000, mcLoops = 50, init = TRUE, innovations.gen = sobolInnovations, path.gen = wienerPath, payoff.calc = arithmeticAsianPayoff, antithetic = TRUE, standardization = FALSE, trace = TRUE, scrambling = 2, seed = 4711) # Plot the MC Iteration Path: par(mfrow = c(1, 1)) mcPrice = cumsum(mc)/(1:length(mc)) plot(mcPrice, type = "l", main = "Arithmetic Asian Option", xlab = "Monte Carlo Loops", ylab = "Option Price") # Compare with Turnbull-Wakeman Approximation: # ... requires(fExoticOptions) # TW = TurnbullWakemanAsianApproxOption(TypeFlag = "c", S = 100, SA = 100, # X = 100, Time = 1/12, time = 1/12, tau = 0 , r = 0.1, b = 0.1, # sigma = 0.4)$price # print(TW) TW = 2.859122 abline(h = TW, col = 2) # Return Value: return() } ################################################################################ fOptions/inst/unitTests/runit.LowDiscrepancy.R0000644000175100001440000001501012620131167021255 0ustar hornikusers # 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: DESCRIPTION: # runif.pseudo Uniform Pseudo Random number sequence # rnorm.pseudo Normal Pseudo Random number sequence # runif.halton Uniform Halton low discrepancy sequence # rnorm.halton Normal Halton low discrepancy sequence # runif.sobol Uniform Sobol low discrepancy sequence # rnorm.sobol Normal Sobol low discrepancy sequence ################################################################################ test.pseudo = function() { # Pseudo Random Numbers: # Uniform and Normal pseudo random number sequences # RVs: RNGkind(kind = "Marsaglia-Multicarry", normal.kind = "Inversion") set.seed(4711, kind = "Marsaglia-Multicarry") # Graphics Frame: par(mfrow = c(2, 2), cex = 0.75) # Histogram Uniform: runif.pseudo(n = 10, dimension = 5) r = runif.pseudo(n = 1000, dimension = 1) hist(r, probability = TRUE, main = "Uniform Pseudo", xlab = "x", col = "steelblue", border = "white") abline (h = 1, col = "orange", lwd = 2) # Scatterplot Uniform: r = runif.pseudo(n = 1000, dimension = 2) plot(r, cex = 0.5, main = "Scatterplot Uniform Pseudo") # Histogram Normal: rnorm.pseudo(n = 10, dimension = 5) r = rnorm.pseudo(n = 1000, dimension = 1) hist(r, probability = TRUE, xlim = c(-3, 3), main = "Normal Pseudo", xlab = "x", col = "steelblue", border = "white") x = seq(-3, 3, length = 301) lines(x, dnorm(x), col = "orange", lwd = 2) # Scatterplot Normal: r = rnorm.pseudo(n = 1000, dimension = 2) plot(r, cex = 0.5, main = "Scatterplot Normal Pseudo") # Return Value: return() } # ------------------------------------------------------------------------------ test.halton = function() { # Halton Sequence: # Uniform and Normal Halton low discrepancy sequences # RVs: RNGkind(kind = "Marsaglia-Multicarry", normal.kind = "Inversion") set.seed(4711, kind = "Marsaglia-Multicarry") # Graphics Frame: par(mfrow = c(2, 2), cex = 0.75) # Histogram Uniform: runif.halton(n = 10, dimension = 5) r = runif.halton(n = 5000, dimension = 1) hist(r, probability = TRUE, main = "Uniform Halton", xlab = "x", col = "steelblue", border = "white") abline (h = 1, col = "orange", lwd = 2) # Scatterplot Uniform: r = runif.halton(n = 1000, dimension = 2) plot(r, cex = 0.5, main = "Scatterplot Uniform Halton") # Histogram Normal: rnorm.halton(n = 10, dimension = 5) r = rnorm.halton(n = 5000, dimension = 1) hist(r, probability = TRUE, xlim = c(-3, 3), main = "Normal Halton", xlab = "x", col = "steelblue", border = "white") x = seq(-3, 3, length = 301) lines(x, dnorm(x), col = "orange", lwd = 2) # Scatterplot Normal: r = rnorm.halton(n = 1000, dimension = 2) plot(r, cex = 0.5, main = "Scatterplot Normal Halton") # Return Value: return() } # ------------------------------------------------------------------------------ test.sobol = function() { # Sobol Sequence: # Uniform and Normal Sobol low discrepancy sequences # RVs: RNGkind(kind = "Marsaglia-Multicarry", normal.kind = "Inversion") set.seed(4711, kind = "Marsaglia-Multicarry") # Graphics Frame: par(mfrow = c(2, 2), cex = 0.75) # Histogram Uniform: runif.sobol(n = 10, dimension = 5) r = runif.sobol(5000, 1) hist(r, probability = TRUE, main = "Uniform Sobol", xlab = "x", col = "steelblue", border = "white") abline (h = 1, col = "orange", lwd = 2) # Scatterplot Uniform: r = runif.sobol(n = 1000, dimension = 2) plot(r, cex = 0.5, main = "Scatterplot Uniform Sobol") # Histogram Normal: rnorm.sobol(n = 10, dimension = 5) r = rnorm.sobol(1000, 1) hist(r, probability = TRUE, main = "Normal Sobol", xlab = "x", col = "steelblue", border = "white") x = seq(-3, 3, length = 301) lines(x, dnorm(x), col = "orange", lwd = 2) # Scatterplot Normal: r = rnorm.sobol(n = 1000, dimension = 2) plot(r, cex = 0.5, main = "Scatterplot Normal Sobol") # Return Value: return() } # ------------------------------------------------------------------------------ test.scrambling = function() { # Sobol Scrambling: # RVs: RNGkind(kind = "Marsaglia-Multicarry", normal.kind = "Inversion") set.seed(4711, kind = "Marsaglia-Multicarry") # runif.sobol(n, dimension, init = TRUE, scrambling = 0, seed = 4711) # Unscrambled: runif.sobol(10, 5) # Owen Type Scrambling: runif.sobol(10, 5, scrambling = 1) # Faure-Tezuka Type Scrambling: runif.sobol(10, 5, scrambling = 2) # Combined Owen and Faure-Tezuka Type Scrambling: runif.sobol(10, 5, scrambling = 3) # Return Value: return() } # ------------------------------------------------------------------------------ test.restart = function() { # Sobol Restart: # RVs: RNGkind(kind = "Marsaglia-Multicarry", normal.kind = "Inversion") set.seed(4711, kind = "Marsaglia-Multicarry") # runif.sobol(n, dimension, init = TRUE, scrambling = 0, seed = 4711) runif.sobol(10, 5, init = TRUE) runif.sobol(10, 5, init = FALSE) # Seed: print(.getfOptionsEnv(".runif.sobol.seed")) # Return Value: return() } ################################################################################ fOptions/inst/unitTests/runTests.R0000644000175100001440000000453012620131167017023 0ustar hornikuserspkg <- "fOptions" 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") } ################################################################################ fOptions/inst/unitTests/runit.HestonNandiGarchFit.R0000644000175100001440000000715712620131167022166 0ustar hornikusers # 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: DESCRIPTION: # hngarchSim Simulates an HN-GARCH(1,1) Time Series Process # hngarchFit Fits a HN-GARCH model by Gaussian Maximum Likelihood # print.hngarch Print method, reports results # summary.hngarch Summary method, diagnostic analysis # hngarchStats Computes Unconditional Moments of a HN-GARCH Process ################################################################################ test.hngarchSim = function() { # Simulate a Heston-Nandi Garch(1,1) Process # RVs: RNGkind(kind = "Marsaglia-Multicarry", normal.kind = "Inversion") set.seed(4711, kind = "Marsaglia-Multicarry") # Symmetric Model - Parameters: model = list(lambda = 4, omega = 8e-5, alpha = 6e-5, beta = 0.7, gamma = 0, rf = 0) # Series: x = hngarchSim(model = model, n = 500, n.start = 100) # Plot: par(mfrow = c(2, 1), cex = 0.75) plot(x, type = "l", col = "steelblue", main = "HN Garch Symmetric Model") grid() # Return Value: return() } # ------------------------------------------------------------------------------ test.hngarchFit = function() { # Simulate a Heston-Nandi Garch(1,1) Process: # RVs: RNGkind(kind = "Marsaglia-Multicarry", normal.kind = "Inversion") set.seed(4711, kind = "Marsaglia-Multicarry") # Symmetric Model - Parameters: model = list(lambda = 4, omega = 8e-5, alpha = 6e-5, beta = 0.7, gamma = 0, rf = 0) x = hngarchSim(model = model, n = 500, n.start = 100) # Estimate Parameters: # HN-GARCH log likelihood Parameter Estimation: # To speed up, we start with the simulated model ... # Fit Symmetric Case: mle = hngarchFit(x = x, model = model, trace = TRUE, symmetric = TRUE) print(mle) # Assymmetric Case: mle = hngarchFit(x = x, model = model, trace = TRUE, symmetric = FALSE) print(mle) # HN GARCH Plot: # ... there is no plot - plotting is done in summary # HN-GARCH Diagnostic Analysis: # Note, residuals are still missing ... par(mfrow = c(3, 1)) summary(mle, col = "steelblue") # HN-GARCH Moments: hngarchStats(mle$model) # Return Value: return() } ################################################################################ fOptions/tests/0000755000175100001440000000000012620131167013232 5ustar hornikusersfOptions/tests/doRUnit.R0000644000175100001440000000151612620131167014744 0ustar hornikusers#### 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) } fOptions/src/0000755000175100001440000000000012620131167012657 5ustar hornikusersfOptions/src/Makevars0000644000175100001440000000005612620131167014354 0ustar hornikusersPKG_LIBS=$(LAPACK_LIBS) $(BLAS_LIBS) $(FLIBS) fOptions/src/LowDiscrepancy.f0000644000175100001440000024534412620131167015770 0ustar hornikusersC PART I: HALTON SEQUENCE C PART II: SOBOL SEQUENCE C############################################################################### C PART I: HALTON SEQUENCE: C------------------------------------------------------------------------------- C @file LowDiscrepancy.f C @brief Halton sequence C C @author Diethelm Wuertz C @author Christophe Dutang C @author Yohan Chalabi C C Copyright (C) Sept. 2002, Diethelm Wuertz, ETH Zurich. All rights C reserved. slightly modified (better accuracy and speed) by C Christophe Dutang in October 2009. Delcared all variables and C functions to avoid troubles with new version of gfortran by Yohan C Chalabi in June 2011. C C The new BSD License is applied to this software. C Copyright (c) Diethelm Wuertz, ETH Zurich. All rights reserved. C C Redistribution and use in source and binary forms, with or without C modification, are permitted provided that the following conditions are C met: C C - Redistributions of source code must retain the above copyright C notice, this list of conditions and the following disclaimer. C - Redistributions in binary form must reproduce the above C Copyright notice, this list of conditions and the following C disclaimer in the documentation and/or other materials provided C with the distribution. C - Neither the name of the ETH Zurich nor the names of its contributors C may be used to endorse or promote products derived from this software C without specific prior written permission. C C THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS C "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT C LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR C A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT C OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, C SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT C LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, C DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY C THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT C (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE C OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. C C------------------------------------------------------------------------------- C------------------------------------------------------------------------------- C INITHALTON (DIMEN, QUASI, BASE, OFFSET) C NEXTHALTON (DIMEN, QUASI, BASE, OFFSET) C HALTON (QN, N, DIMEN, QUASI, BASE, OFFSET, INIT, TRANSFORM) C REAL*8 FUNCTION HQNORM(P) C------------------------------------------------------------------------------- SUBROUTINE INITHALTON(DIMEN, QUASI, BASE, OFFSET) C INITIALIZE THE HALTON LOW DISCREPANCY SEQUENCE. C THE BASE IS CALCULATED FROM PRIMES IMPLICIT NONE c Args INTEGER DIMEN, BASE(DIMEN), OFFSET DOUBLE PRECISION QUASI(DIMEN) c Vars INTEGER ITER(DIMEN), DIGIT DOUBLE PRECISION HALF INTEGER NC, I, K, M, N, NB INTRINSIC MOD C INIT BASE FROM PRIMES - THIS IMPLEMENTS A SIMPLE SIEVE: BASE(1) = 2 IF(DIMEN .ge. 2) BASE(2) = 3 N = 3 NC = 2 DO WHILE(NC.LT.DIMEN) M = N/2 K = 0 IF (MOD(N,2).NE.0.AND.MOD(N,3).NE.0) THEN DO I = 5, M IF(MOD(N,I).EQ.0) K = K + 1 ENDDO IF (K.EQ.0) THEN NC = NC + 1 BASE(NC) = N ENDIF ENDIF N = N + 1 ENDDO C NOW CREATE THE FIRST QUASI RANDOM NUMBER: OFFSET = 0 DO NB = 1, DIMEN ITER(NB) = OFFSET QUASI(NB) = 0.0D0 HALF = 1.0D0 / BASE(NB) DO WHILE (ITER(NB).NE.0) DIGIT = MOD ( ITER(NB), BASE(NB) ) QUASI(NB) = QUASI(NB) + DIGIT * HALF ITER(NB) = ( ITER(NB) - DIGIT ) / BASE(NB) HALF = HALF / BASE(NB) ENDDO ENDDO C SET THE COUNTER: OFFSET = OFFSET + 1 RETURN END C------------------------------------------------------------------------------- SUBROUTINE NEXTHALTON(DIMEN, QUASI, BASE, OFFSET) C GENERATE THE NEXT POINT IN HALTON'S LOW DISCREPANCY SEQUENCE C NOTE, THAT WE HAVE ALREADY "OFFSET" POINTS GENERATED. IMPLICIT NONE INTEGER DIMEN, BASE(DIMEN), ITER(DIMEN), OFFSET, DIGIT DOUBLE PRECISION QUASI(DIMEN), HALF INTRINSIC MOD INTEGER NB DO NB = 1, DIMEN ITER(NB) = OFFSET QUASI(NB) = 0.0D0 HALF = 1.0D0 / BASE(NB) DO WHILE (ITER(NB).NE.0) DIGIT = MOD ( ITER(NB), BASE(NB) ) QUASI(NB) = QUASI(NB) + DIGIT * HALF ITER(NB) = ( ITER(NB) - DIGIT ) / BASE(NB) HALF = HALF / BASE(NB) ENDDO ENDDO C INCREASE THE COUNTER BY ONE: OFFSET = OFFSET + 1 RETURN END C------------------------------------------------------------------------------- SUBROUTINE HALTON(QN, N, DIMEN, BASE, OFFSET, INIT, TRANSFORM) C THIS IS AN INTERFACE TO CREATE "N" POINTS IN "DIMEN" DIMENSIONS C ARGUMENTS: C QN - THE QUASI NUMBERS, A "N" BY "DIMEN" ARRAY C N - NUMBERS OF POINTS TO GENERATE C DIMEN - THE DIMENSION C BASE - THE PRIME BASE, A VECTOR OF LENGTH "DIMEN" C OFFSET - THE OFFSET OF POINTS IN THE NEXT FUNCTION CALL C INIT - IF ONE, WE INITIALIZE C TRANSFORM - A FLAG, 0 FOR UNIFORM, 1 FOR NORMAL DISTRIBUTION IMPLICIT NONE c Args INTEGER N, DIMEN, OFFSET, INIT, TRANSFORM INTEGER BASE(DIMEN) DOUBLE PRECISION QN(N,DIMEN) c Vars C QUASI - THE LAST POINT IN THE SEQUENCE DOUBLE PRECISION QUASI(DIMEN), HQNORM INTEGER I, J C IF REQUESTED, INITIALIZE THE GENERATOR: IF (INIT.EQ.1) THEN CALL INITHALTON(DIMEN, QUASI, BASE, OFFSET) ENDIF C GENERATE THE NEXT "N" QUASI RANDOM NUMBERS: IF (TRANSFORM.EQ.0) THEN DO I=1, N CALL NEXTHALTON(DIMEN, QUASI, BASE, OFFSET) DO J = 1, DIMEN QN(I, J) = QUASI(J) ENDDO ENDDO ELSE DO I=1, N CALL NEXTHALTON(DIMEN, QUASI, BASE, OFFSET) DO J = 1, DIMEN QN(I, J) = HQNORM(QUASI(J)) ENDDO ENDDO ENDIF RETURN END C------------------------------------------------------------------------------- DOUBLE PRECISION FUNCTION HQNORM(P) IMPLICIT NONE C USED TO CALCULATE HALTON NORMAL DEVIATES: DOUBLE PRECISION P,R,T,A,B, EPS DOUBLE PRECISION P0,P1,P2,P3,P4, Q0,Q1,Q2,Q3,Q4 DATA P0,P1,P2,P3,P4, Q0,Q1,Q2,Q3,Q4 & /-0.322232431088E+0, -1.000000000000E+0, -0.342242088547E+0, & -0.204231210245E-1, -0.453642210148E-4, +0.993484626060E-1, & +0.588581570495E+0, +0.531103462366E+0, +0.103537752850E+0, & +0.385607006340E-2 / C NOTE, IF P BECOMES 1, THE PROGRAM FAILS TO CALCULATE THE C NORMAL RDV. IN THIS CASE WE REPLACE THE LOW DISCREPANCY C POINT WITH A POINT FAR IN THE TAILS. EPS = 1.0D-6 IF (P.GE.(1.0D0-EPS)) P = 1.0d0 - EPS IF (P.LE.EPS) P = EPS IF (P.NE.0.5D0) GOTO 150 HQNORM = 0.0D0 RETURN 150 R = P IF (P.GT.0.5D0) R = 1.0 - R T = DSQRT(-2.0*DLOG(R)) A = ((((T*P4 + P3)*T+P2)*T + P1)*T + P0) B = ((((T*Q4 + Q3)*T+Q2)*T + Q1)*T + Q0) HQNORM = T + (A/B) IF (P.LT.0.5D0) HQNORM = -HQNORM RETURN END C------------------------------------------------------------------------------- c$$$ c$$$ SUBROUTINE TESTHALTON() c$$$ c$$$ IMPLICIT NONE c$$$ c$$$ INTEGER N1,N2,DIMEN,OFFSET,TRANSFORM c$$$ PARAMETER (N1=20,N2=N1/2,DIMEN=5) c$$$ INTEGER BASE(DIMEN) c$$$ DOUBLE PRECISION QN1(N1,DIMEN),QN2(N2,DIMEN) c$$$ INTEGER J, I, INIT c$$$ c$$$ TRANSFORM = 0 c$$$ c$$$C FIRST TEST RUN: c$$$ INIT = 1 c$$$ OFFSET = 0 c$$$ CALL HALTON(QN1,N1,DIMEN,BASE,OFFSET,INIT,TRANSFORM) c$$$ c$$$ WRITE (*,*) c$$$ WRITE (*,*) "HALTON SEQUENCE: 1-20" c$$$ WRITE (*,*) c$$$ WRITE (*,7) "N/DIMEN:", (J, J=1,DIMEN,INT(DIMEN/5)) c$$$ DO I=1, N1, INT(N1/(2*10)) c$$$ WRITE (*,8) I, (QN1(I,J), J=1, DIMEN, INT(DIMEN/5)) c$$$ ENDDO c$$$ c$$$C SECOND TEST RUN: c$$$ INIT=1 c$$$ OFFSET = 0 c$$$ CALL HALTON(QN2,N2,DIMEN,BASE,OFFSET,INIT,TRANSFORM) c$$$ WRITE (*,*) c$$$ WRITE (*,*) "HALTON SEQUENCE: 1-10 RE-INITIALIZED" c$$$ WRITE (*,*) c$$$ WRITE (*,7) "N/DIMEN:", (J, J=1,DIMEN,INT(DIMEN/5)) c$$$ DO I=1, N2, INT(N2/10) c$$$ WRITE (*,8) I, (QN2(I,J), J=1, DIMEN, INT(DIMEN/5)) c$$$ ENDDO c$$$ c$$$ INIT = 0 c$$$ CALL HALTON(QN2,N2,DIMEN,BASE,OFFSET,INIT,TRANSFORM) c$$$ WRITE (*,*) c$$$ WRITE (*,*) "HALTON SEQUENCE: 11-20 CONTINUED" c$$$ WRITE (*,*) c$$$ WRITE (*,7) "N/DIMEN:", (J, J=1,DIMEN,INT(DIMEN/5)) c$$$ DO I=1, N2, INT(N2/10) c$$$ WRITE (*,8) I+N2, (QN2(I,J), J=1, DIMEN, INT(DIMEN/5)) c$$$ ENDDO c$$$ c$$$ 7 FORMAT(1H ,A8, 10I10) c$$$ 8 FORMAT(1H ,I8, 10F10.6) c$$$ c$$$ RETURN c$$$ END C------------------------------------------------------------------------------- c program mainhalton c call testhalton c end C############################################################################### C PART II: SOBOL SEQUENCE: C-------------------------------------------------------------------------- C @file LowDiscrepancy.f C @brief Sobol sequence C C @author Diethelm Wuertz C C ORIGINAL VERSION: C ALGORITHM 659, COLLECTED ALGORITHMS FROM ACM. PUBLISHED IN C TRANSACTIONS ON MATHEMATICAL SOFTWARE, VOL. 14, NO. 1, P.88. C ADDED SCRAMBLING: C FROM PROGRAM "SSOBOL.F" PUBLISHED ON THE INTERNET SITE C www.mcqmc.org/Software.html C EXTENSION TO MAXD=1111: C BY S. JOE ON 17 MAY 2001, SEE: C MODIFICATIONS FOR R / SPLUS: C BY D. WUERTZ, SEPT. 2002; NOTE THE CHECK OF A VALID DIMENSION C VALUE AND THE MAXIMUM NUMBER OF CALLS (ATMOST) HAS TO BE DONE C R/SPLUS FUNCTION. C SEE: C http://www.acm.org/pubs/copyright_policy/softwareCRnotice.html C C @author Christophe Dutang C C Copyright (C) Sept. 2002, Diethelm Wuertz, ETH Zurich. All rights reserved. C slightly modified (better accuracy and speed) by Christophe Dutang in October 2009. C C The new BSD License is applied to this software. C Copyright (c) Diethelm Wuertz, ETH Zurich. All rights reserved. C C Redistribution and use in source and binary forms, with or without C modification, are permitted provided that the following Conditions are C met: C C - Redistributions of source Code must retain the above Copyright C notice, this list of Conditions and the following disclaimer. C - Redistributions in binary form must reproduce the above C Copyright notice, this list of Conditions and the following C disclaimer in the documentation and/or other materials provided C with the distribution. C - Neither the name of the ETH Zurich nor the names of its Contributors C may be used to endorse or promote products derived from this software C without specific prior written permission. C C THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS C "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT C LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR C A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT C OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, C SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT C LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, C DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY C THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT C (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE C OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. C C-------------------------------------------------------------------------- C FUNCTIONS: C SOBOL (QN, N, DIMEN, QUASI, C LL, COUNT, SV, C scrambling, iSEED, INIT, TRANSFORM) C REAL*8 FUNCTION SQNORM (P) C INITSOBOL (DIMEN, QUASI, LL, COUNT, SV, scrambling, iSEED) C SGENSCRML (MAX, LSM, SHIFT, S, MAXCOL, iSEED) C SGENSCRMU (USM, USHIFT, S, MAXCOL, iSEED) C REAL*8 FUNCTION UNIS (iSEED) C NEXTSOBOL (DIMEN, QUASI, LL, COUNT, SV) C------------------------------------------------------------------------------- SUBROUTINE SOBOL(QN, N, DIMEN, QUASI, LL, COUNT, SV, & scrambling, iSEED, INIT, TRANSFORM) C THIS IS AN INTERFACE TO CREATE "N" POINTS IN "DIMEN" DIMENSIONS C ARGUMENTS: C QN - QUASI NUMBERS, A "N" BY "DIMEN" ARRAY C N - NUMBERS OF POINTS TO GENERATE C DIMEN - DIMENSION OF THE SEQUENCE C QUASI - LAST POINT IN THE SEQUENCE C LL - COMMON DENOMINATOR OF THE ELEMENTS IN SV C COUNT - SEQUENCE NUMBER OF THE CALL C SV - TABLE OF DIRECTION NUMBERS C scrambling - INITIALIZATION FLAG C 0 - NO SCRAMBLING C 1 - OWEN TYPE SCRAMBLING C 2 - FAURE-TEZUKA TYPE SCRAMBLING C 3 - OWEN + FAURE-TEZUKA TYPE SCRAMBLING C iSEED - SCRAMBLING iSEED C INIT - INITIALIZATION FLAG, 0 NEXT, 1 RE-INITIALIZE C TRANSFORM - FLAG, 0 FOR UNIFORM, 1 FOR NORMAL DISTRIBUTION IMPLICIT NONE INTEGER MAXBIT,N,DIMEN,INIT,TRANSFORM PARAMETER (MAXBIT=30) INTEGER LL,COUNT,SV(DIMEN,MAXBIT) INTEGER iSEED, scrambling, I, J DOUBLE PRECISION QN(N,DIMEN), QUASI(DIMEN) DOUBLE PRECISION SQNORM EXTERNAL SQNORM IF (INIT.EQ.1) THEN CALL INITSOBOL(DIMEN, QUASI, LL, COUNT, SV, scrambling, iSEED) ENDIF C GENERATE THE NEXT "N" QUASI RANDOM NUMBERS: IF (TRANSFORM.EQ.0) THEN DO I=1, N CALL NEXTSOBOL(DIMEN, QUASI, LL, COUNT, SV) DO J = 1, DIMEN QN(I, J) = QUASI(J) ENDDO ENDDO ELSE DO I=1, N CALL NEXTSOBOL(DIMEN, QUASI, LL, COUNT, SV) DO J = 1, DIMEN QN(I, J) = SQNORM(QUASI(J)) ENDDO ENDDO ENDIF RETURN END C------------------------------------------------------------------------------- DOUBLE PRECISION FUNCTION SQNORM(P) IMPLICIT NONE C USED TO CALCULATE SOBOL NORMAL DEVIATES DOUBLE PRECISION P,R,T,A,B, EPS DOUBLE PRECISION P0,P1,P2,P3,P4, Q0,Q1,Q2,Q3,Q4 DATA P0,P1,P2,P3,P4, Q0,Q1,Q2,Q3,Q4 & /-0.322232431088E+0, -1.000000000000E+0, -0.342242088547E+0, & -0.204231210245E-1, -0.453642210148E-4, +0.993484626060E-1, & +0.588581570495E+0, +0.531103462366E+0, +0.103537752850E+0, & +0.385607006340E-2 / C NOTE, IF P BECOMES 1, THE PROGRAM FAILS TO CALCULATE THE C NORMAL RDV. IN THIS CASE WE REPLACE THE LOW DISCREPANCY C POINT WITH A POINT FAR IN THE TAILS. EPS = 1.0D-6 IF (P.GE.(1.0D0-EPS)) P=1.0D0-EPS IF (P.LE.EPS) P=EPS IF (P.NE.0.5D0) GOTO 150 SQNORM = 0.0D0 RETURN 150 R = P IF (P.GT.0.5D0) R = 1.0D0 - R T = DSQRT(-2.0*DLOG(R)) A = ((((T*P4 + P3)*T+P2)*T + P1)*T + P0) B = ((((T*Q4 + Q3)*T+Q2)*T + Q1)*T + Q0) SQNORM = T + (A/B) IF (P.LT.0.5D0) SQNORM = -SQNORM RETURN END C------------------------------------------------------------------------------- SUBROUTINE INITSOBOL(DIMEN, QUASI, LL, COUNT, SV, & scrambling, iSEED) C INITIALIZATION OF THE SOBOL GENERATOR: C THE LEADING ELEMENTS OF EACH ROW OF SV ARE INITIALIZED USING "VINIT". C EACH ROW CORRESPONDS TO A PRIMITIVE POLYNOMIAL. IF THE POLYNOMIAL C HAS DEGREE "M", ELEMENTS AFTER THE FIRST "M" ARE CALCULATED. C THE NUMBERS IN "SV" ARE ACTUALLY BINARY FRACTIONS. "RECIPD=1/LL" C HOLDS 1/(THE COMMON DENOMINATOR OF ALL OF THEM). C INITSOBOL IMPLICITLY COMPUTES THE FIRST ALL-ZERO VECTOR. C THE TAUS" IS FOR DETERMINING "FAVORABLE" VALUES. AS DISCUSSED IN C BRATLEY/FOX, THESE HAVE THE FORM "N=2**K" WHERE "K.GE.(TAUS+S-1)" C FOR INTEGRATION AND "K.GT.TAUS" FOR GLOBAL OPTIMIZATION. C ARGUMENTS: C DIMEN - DIMENSION OF THE SEQUENCE C QUASI - LAST POINT IN THE SEQUENCE C LL - COMMON DENOMINATOR OF THE ELEMENTS IN SV C COUNT - SEQUENCE NUMBER OF THE CALL C SV - TABLE OF DIRECTION NUMBERS C scrambling - INITIALIZATION FLAG C 0 - NO SCRAMBLING C 1 - OWEN TYPE SCRAMBLING C 2 - FAURE-TEZUKA TYPE SCRAMBLING C 3 - OWEN + FAURE-TEZUKA TYPE SCRAMBLING C iSEED - SCRAMBLING iSEED IMPLICIT NONE INTEGER MAXDIM,MAXDEG,MAXBIT,scrambling C C DW ADDED FOLLOWING LINE: INTEGER P,PP PARAMETER (MAXDIM=1111,MAXDEG=13,MAXBIT=30) INTEGER ATMOST,DIMEN,TAUS,COUNT,MAXCOL,S INTEGER POLY(2:MAXDIM),VINIT(2:MAXDIM,MAXDEG) INTEGER SV(DIMEN,MAXBIT),V(DIMEN,MAXBIT) INTEGER I,J,K,L,M,NEWV,TAU(MAXDEG) INTEGER USM(31,31),USHIFT(31) C C INTEGER TEMP1,TEMP2,TEMP4 INTEGER TEMP1,TEMP2,TEMP3,TEMP4 INTEGER SHIFT(1111),LSM(1111,31),TV(1111,31,31) DOUBLE PRECISION QUASI(DIMEN),RECIPD INTEGER iSEED LOGICAL INCLUD(MAXDEG) INTRINSIC MOD, IEOR INTEGER LL, MAXX, MAX, TEMP01 DATA (POLY(I),I=2,211)/3,7,11,13,19,25,37,59,47,61,55,41,67,97,91, + 109,103,115,131,193,137,145,143,241,157,185,167,229,171,213, + 191,253,203,211,239,247,285,369,299,301,333,351,355,357,361, + 391,397,425,451,463,487,501,529,539,545,557,563,601,607,617, + 623,631,637,647,661,675,677,687,695,701,719,721,731,757,761, + 787,789,799,803,817,827,847,859,865,875,877,883,895,901,911, + 949,953,967,971,973,981,985,995,1001,1019,1033,1051,1063, + 1069,1125,1135,1153,1163,1221,1239,1255,1267,1279,1293,1305, + 1315,1329,1341,1347,1367,1387,1413,1423,1431,1441,1479,1509, + 1527,1531,1555,1557,1573,1591,1603,1615,1627,1657,1663,1673, + 1717,1729,1747,1759,1789,1815,1821,1825,1849,1863,1869,1877, + 1881,1891,1917,1933,1939,1969,2011,2035,2041,2053,2071,2091, + 2093,2119,2147,2149,2161,2171,2189,2197,2207,2217,2225,2255, + 2257,2273,2279,2283,2293,2317,2323,2341,2345,2363,2365,2373, + 2377,2385,2395,2419,2421,2431,2435,2447,2475,2477,2489,2503, + 2521,2533,2551,2561,2567,2579,2581,2601,2633,2657,2669/ DATA (POLY(I),I=212,401)/2681,2687,2693,2705,2717,2727,2731,2739, + 2741,2773,2783,2793,2799,2801,2811,2819,2825,2833,2867,2879, + 2881,2891,2905,2911,2917,2927,2941,2951,2955,2963,2965,2991, + 2999,3005,3017,3035,3037,3047,3053,3083,3085,3097,3103,3159, + 3169,3179,3187,3205,3209,3223,3227,3229,3251,3263,3271,3277, + 3283,3285,3299,3305,3319,3331,3343,3357,3367,3373,3393,3399, + 3413,3417,3427,3439,3441,3475,3487,3497,3515,3517,3529,3543, + 3547,3553,3559,3573,3589,3613,3617,3623,3627,3635,3641,3655, + 3659,3669,3679,3697,3707,3709,3713,3731,3743,3747,3771,3791, + 3805,3827,3833,3851,3865,3889,3895,3933,3947,3949,3957,3971, + 3985,3991,3995,4007,4013,4021,4045,4051,4069,4073,4179,4201, + 4219,4221,4249,4305,4331,4359,4383,4387,4411,4431,4439,4449, + 4459,4485,4531,4569,4575,4621,4663,4669,4711,4723,4735,4793, + 4801,4811,4879,4893,4897,4921,4927,4941,4977,5017,5027,5033, + 5127,5169,5175,5199,5213,5223,5237,5287,5293,5331,5391,5405, + 5453,5523,5573,5591,5597,5611,5641,5703,5717,5721,5797,5821, + 5909,5913/ DATA (POLY(I),I=402,591)/5955,5957,6005,6025,6061,6067,6079,6081, + 6231,6237,6289,6295,6329,6383,6427,6453,6465,6501,6523,6539, + 6577,6589,6601,6607,6631,6683,6699,6707,6761,6795,6865,6881, + 6901,6923,6931,6943,6999,7057,7079,7103,7105,7123,7173,7185, + 7191,7207,7245,7303,7327,7333,7355,7365,7369,7375,7411,7431, + 7459,7491,7505,7515,7541,7557,7561,7701,7705,7727,7749,7761, + 7783,7795,7823,7907,7953,7963,7975,8049,8089,8123,8125,8137, + 8219,8231,8245,8275,8293,8303,8331,8333,8351,8357,8367,8379, + 8381,8387,8393,8417,8435,8461,8469,8489,8495,8507,8515,8551, + 8555,8569,8585,8599,8605,8639,8641,8647,8653,8671,8675,8689, + 8699,8729,8741,8759,8765,8771,8795,8797,8825,8831,8841,8855, + 8859,8883,8895,8909,8943,8951,8955,8965,8999,9003,9031,9045, + 9049,9071,9073,9085,9095,9101,9109,9123,9129,9137,9143,9147, + 9185,9197,9209,9227,9235,9247,9253,9257,9277,9297,9303,9313, + 9325,9343,9347,9371,9373,9397,9407,9409,9415,9419,9443,9481, + 9495,9501,9505,9517,9529,9555,9557,9571,9585,9591,9607,9611, + 9621,9625/ DATA (POLY(I),I=592,765)/9631,9647,9661,9669,9679,9687,9707,9731, + 9733,9745,9773,9791,9803,9811,9817,9833,9847,9851,9863,9875, + 9881,9905,9911,9917,9923,9963,9973,10003,10025,10043,10063, + 10071,10077,10091,10099,10105,10115,10129,10145,10169,10183, + 10187,10207,10223,10225,10247,10265,10271,10275,10289,10299, + 10301,10309,10343,10357,10373,10411,10413,10431,10445,10453, + 10463,10467,10473,10491,10505,10511,10513,10523,10539,10549, + 10559,10561,10571,10581,10615,10621,10625,10643,10655,10671, + 10679,10685,10691,10711,10739,10741,10755,10767,10781,10785, + 10803,10805,10829,10857,10863,10865,10875,10877,10917,10921, + 10929,10949,10967,10971,10987,10995,11009,11029,11043,11045, + 11055,11063,11075,11081,11117,11135,11141,11159,11163,11181, + 11187,11225,11237,11261,11279,11297,11307,11309,11327,11329, + 11341,11377,11403,11405,11413,11427,11439,11453,11461,11473, + 11479,11489,11495,11499,11533,11545,11561,11567,11575,11579, + 11589,11611,11623,11637,11657,11663,11687,11691,11701,11747, + 11761,11773,11783,11795,11797,11817,11849,11855,11867,11869, + 11873,11883,11919/ DATA (POLY(I),I=766,936)/11921,11927,11933,11947,11955,11961, + 11999,12027,12029,12037,12041,12049,12055,12095,12097,12107, + 12109,12121,12127,12133,12137,12181,12197,12207,12209,12239, + 12253,12263,12269,12277,12287,12295,12309,12313,12335,12361, + 12367,12391,12409,12415,12433,12449,12469,12479,12481,12499, + 12505,12517,12527,12549,12559,12597,12615,12621,12639,12643, + 12657,12667,12707,12713,12727,12741,12745,12763,12769,12779, + 12781,12787,12799,12809,12815,12829,12839,12857,12875,12883, + 12889,12901,12929,12947,12953,12959,12969,12983,12987,12995, + 13015,13019,13031,13063,13077,13103,13137,13149,13173,13207, + 13211,13227,13241,13249,13255,13269,13283,13285,13303,13307, + 13321,13339,13351,13377,13389,13407,13417,13431,13435,13447, + 13459,13465,13477,13501,13513,13531,13543,13561,13581,13599, + 13605,13617,13623,13637,13647,13661,13677,13683,13695,13725, + 13729,13753,13773,13781,13785,13795,13801,13807,13825,13835, + 13855,13861,13871,13883,13897,13905,13915,13939,13941,13969, + 13979,13981,13997,14027,14035,14037,14051,14063,14085,14095, + 14107,14113,14125,14137,14145/ DATA (POLY(I),I=937,1107)/14151,14163,14193,14199,14219,14229, + 14233,14243,14277,14287,14289,14295,14301,14305,14323,14339, + 14341,14359,14365,14375,14387,14411,14425,14441,14449,14499, + 14513,14523,14537,14543,14561,14579,14585,14593,14599,14603, + 14611,14641,14671,14695,14701,14723,14725,14743,14753,14759, + 14765,14795,14797,14803,14831,14839,14845,14855,14889,14895, + 14909,14929,14941,14945,14951,14963,14965,14985,15033,15039, + 15053,15059,15061,15071,15077,15081,15099,15121,15147,15149, + 15157,15167,15187,15193,15203,15205,15215,15217,15223,15243, + 15257,15269,15273,15287,15291,15313,15335,15347,15359,15373, + 15379,15381,15391,15395,15397,15419,15439,15453,15469,15491, + 15503,15517,15527,15531,15545,15559,15593,15611,15613,15619, + 15639,15643,15649,15661,15667,15669,15681,15693,15717,15721, + 15741,15745,15765,15793,15799,15811,15825,15835,15847,15851, + 15865,15877,15881,15887,15899,15915,15935,15937,15955,15973, + 15977,16011,16035,16061,16069,16087,16093,16097,16121,16141, + 16153,16159,16165,16183,16189,16195,16197,16201,16209,16215, + 16225,16259,16265,16273,16299/ DATA (POLY(I),I=1108,1111)/16309,16355,16375,16381/ DATA (VINIT(I,1),I=2,1111)/1110*1/ DATA (VINIT(I,2),I=3,401)/1,3,1,3,1,3,3,1,3,1,3,1,3,1,1,3,1,3,1,3, + 1,3,3,1,1,1,3,1,3,1,3,3,1,3,1,1,1,3,1,3,1,1,1,3,3,1,3,3,1,1, + 3,3,1,3,3,3,1,3,1,3,1,1,3,3,1,1,1,1,3,1,1,3,1,1,1,3,3,1,3,3, + 1,3,3,3,1,3,3,3,1,3,3,1,3,3,3,1,3,1,3,1,1,3,3,1,3,3,1,1,1,3, + 3,1,3,3,1,3,1,1,3,3,3,1,1,1,3,1,1,3,1,1,3,3,1,3,1,3,3,3,3,1, + 1,1,3,3,1,1,3,1,1,1,1,1,1,3,1,3,1,1,1,3,1,3,1,3,3,3,1,1,3,3, + 1,3,1,3,1,1,3,1,3,1,3,1,3,1,1,1,3,3,1,3,3,1,3,1,1,1,3,1,3,1, + 1,3,1,1,3,3,1,1,3,3,3,1,3,3,3,1,3,1,3,1,1,1,3,1,1,1,3,1,1,1, + 1,1,3,3,3,1,1,1,1,3,3,3,1,3,3,1,1,1,1,3,1,1,3,1,3,3,1,1,3,3, + 1,1,1,1,3,1,3,3,1,3,3,1,1,1,3,3,3,1,3,3,1,3,3,1,3,1,3,3,3,1, + 3,1,1,3,1,3,1,1,1,3,3,3,1,1,3,1,3,1,1,1,1,1,1,3,1,1,3,1,3,3, + 1,1,1,1,3,1,3,1,3,1,1,1,1,3,3,1,1,1,1,1,3,3,3,1,1,3,3,3,3,3, + 1,3,3,1,3,3,3,3,1,1,1,1,1,1,3,1,1,3,1,1,1,3,1,1,1,3,3,3,1,3, + 1,1,3,3,3,1,3,3,1,3,1,3,3,1,3,3,3,1,1/ DATA (VINIT(I,2),I=402,800)/3,3,1,3,1,3,1,1,1,3,3,3,3,1,3,1,1,3,1, + 3,1,1,1,3,1,3,1,3,1,3,3,3,3,3,3,3,3,1,3,3,3,3,3,1,3,1,3,3,3, + 1,3,1,3,1,3,3,1,3,3,3,3,3,3,3,3,3,1,1,1,1,1,1,3,3,1,1,3,3,1, + 1,1,3,3,1,1,3,3,3,3,1,1,3,1,3,3,1,3,3,1,1,1,3,3,3,1,1,3,3,3, + 3,3,1,1,1,3,1,3,3,1,3,3,3,3,1,1,3,1,1,3,1,3,1,3,1,3,3,1,1,3, + 3,1,3,3,1,3,3,1,1,3,1,3,3,1,1,3,1,3,1,3,1,1,3,3,1,1,1,3,3,1, + 3,1,1,3,3,1,1,3,1,3,1,1,1,1,1,3,1,1,1,1,3,1,3,1,1,3,3,1,1,3, + 1,3,1,3,3,3,1,3,3,3,1,1,3,3,3,1,1,1,1,3,1,3,1,3,1,1,3,3,1,1, + 1,3,3,1,3,1,3,1,1,1,1,1,1,3,1,3,3,1,3,3,3,1,3,1,1,3,3,1,1,3, + 3,1,1,1,3,1,3,3,1,1,3,1,1,3,1,3,1,1,1,3,3,3,3,1,1,3,3,1,1,1, + 1,3,1,1,3,3,3,1,1,3,3,1,3,3,1,1,3,3,3,3,3,3,3,1,3,3,1,3,1,3, + 1,1,3,3,1,1,1,3,1,3,3,1,3,3,1,3,1,1,3,3,3,1,1,1,3,1,1,1,3,3, + 3,1,3,3,1,3,1,1,3,3,3,1,3,3,1,1,1,3,1,3,3,3,3,3,3,3,3,1,3,3, + 1,3,1,1,3,3,3,1,3,3,3,3,3,1,3,3,3,1,1,1/ DATA (VINIT(I,2),I=801,1111)/3,3,1,3,3,1,3,1,3,1,3,1,3,3,3,3,3,3, + 1,1,3,1,3,1,1,1,1,1,3,1,1,1,3,1,3,1,1,3,3,3,1,3,1,3,1,1,3,1, + 3,3,1,3,1,3,3,1,3,3,1,3,3,3,3,3,3,1,3,1,1,3,3,3,1,1,3,3,3,3, + 3,3,3,1,3,3,3,3,1,3,1,3,3,3,1,3,1,3,1,1,1,3,3,1,3,1,1,3,3,1, + 3,1,1,1,1,3,1,3,1,1,3,1,3,1,3,3,3,3,3,3,1,3,3,3,3,1,3,3,1,3, + 3,3,3,3,1,1,1,1,3,3,3,1,3,3,1,1,3,3,1,1,3,3,1,3,1,1,3,1,3,3, + 3,3,3,1,3,1,1,3,3,3,3,1,3,1,1,3,3,3,3,3,3,1,1,3,1,3,1,1,3,1, + 1,1,1,3,3,1,1,3,1,1,1,3,1,3,1,1,3,3,1,3,1,1,3,3,3,3,3,1,3,1, + 1,1,3,1,1,1,3,1,1,3,1,3,3,3,3,3,1,1,1,3,3,3,3,1,3,3,3,3,1,1, + 3,3,3,1,3,1,1,3,3,1,3,3,1,1,1,1,1,3,1,1,3,3,1,1,1,3,1,1,3,3, + 1,3,3,3,3,3,3,3,3,1,1,3,3,1,1,3,1,3,3,3,3,3,1/ DATA (VINIT(I,3),I=4,402)/7,5,1,3,3,7,5,5,7,7,1,3,3,7,5,1,1,5,3,7, + 1,7,5,1,3,7,7,1,1,1,5,7,7,5,1,3,3,7,5,5,5,3,3,3,1,1,5,1,1,5, + 3,3,3,3,1,3,7,5,7,3,7,1,3,3,5,1,3,5,5,7,7,7,1,1,3,3,1,1,5,1, + 5,7,5,1,7,5,3,3,1,5,7,1,7,5,1,7,3,1,7,1,7,3,3,5,7,3,3,5,1,3, + 3,1,3,5,1,3,3,3,7,1,1,7,3,1,3,7,5,5,7,5,5,3,1,3,3,3,1,3,3,7, + 3,3,1,7,5,1,7,7,5,7,5,1,3,1,7,3,7,3,5,7,3,1,3,3,3,1,5,7,3,3, + 7,7,7,5,3,1,7,1,3,7,5,3,3,3,7,1,1,3,1,5,7,1,3,5,3,5,3,3,7,5, + 5,3,3,1,3,7,7,7,1,5,7,1,3,1,1,7,1,3,1,7,1,5,3,5,3,1,1,5,5,3, + 3,5,7,1,5,3,7,7,3,5,3,3,1,7,3,1,3,5,7,1,3,7,1,5,1,3,1,5,3,1, + 7,1,5,5,5,3,7,1,1,7,3,1,1,7,5,7,5,7,7,3,7,1,3,7,7,3,5,1,1,7, + 1,5,5,5,1,5,1,7,5,5,7,1,1,7,1,7,7,1,1,3,3,3,7,7,5,3,7,3,1,3, + 7,5,3,3,5,7,1,1,5,5,7,7,1,1,1,1,5,5,5,7,5,7,1,1,3,5,1,3,3,7, + 3,7,5,3,5,3,1,7,1,7,7,1,1,7,7,7,5,5,1,1,7,5,5,7,5,1,1,5,5,5, + 5,5,5,1,3,1,5,7,3,3,5,7,3,7,1,7,7,1,3/ DATA (VINIT(I,3),I=403,801)/5,1,5,5,3,7,3,7,7,5,7,5,7,1,1,5,3,5,1, + 5,3,7,1,5,7,7,3,5,1,3,5,1,5,3,3,3,7,3,5,1,3,7,7,3,7,5,3,3,1, + 7,5,1,1,3,7,1,7,1,7,3,7,3,5,7,3,5,3,1,1,1,5,7,7,3,3,1,1,1,5, + 5,7,3,1,1,3,3,7,3,3,5,1,3,7,3,3,7,3,5,7,5,7,7,3,3,5,1,3,5,3, + 1,3,5,1,1,3,7,7,1,5,1,3,7,3,7,3,5,1,7,1,1,3,5,3,7,1,5,5,1,1, + 3,1,3,3,7,1,7,3,1,7,3,1,7,3,5,3,5,7,3,3,3,5,1,7,7,1,3,1,3,7, + 7,1,3,7,3,1,5,3,1,1,1,5,3,3,7,1,5,3,5,1,3,1,3,1,5,7,7,1,1,5, + 3,1,5,1,1,7,7,3,5,5,1,7,1,5,1,1,3,1,5,7,5,7,7,1,5,1,1,3,5,1, + 5,5,3,1,3,1,5,5,3,3,3,3,1,1,3,1,3,5,5,7,5,5,7,5,7,1,3,7,7,3, + 5,5,7,5,5,3,3,3,1,7,1,5,5,5,3,3,5,1,3,1,3,3,3,7,1,7,7,3,7,1, + 1,5,7,1,7,1,7,7,1,3,7,5,1,3,5,5,5,1,1,7,1,7,1,7,7,3,1,1,5,1, + 5,1,5,3,5,5,5,5,5,3,3,7,3,3,5,5,3,7,1,5,7,5,1,5,5,3,5,5,7,5, + 3,5,5,5,1,5,5,5,5,1,3,5,3,1,7,5,5,7,1,5,3,3,1,5,3,7,1,7,5,1, + 1,3,1,1,7,1,5,5,3,7,3,7,5,3,1,1,3,1,3,5/ DATA (VINIT(I,3),I=802,1111)/5,7,5,3,7,7,7,3,7,3,7,1,3,1,7,7,1,7, + 3,7,3,7,3,7,3,5,1,1,7,3,1,5,5,7,1,5,5,5,7,1,5,5,1,5,5,3,1,3, + 1,7,3,1,3,5,7,7,7,1,1,7,3,1,5,5,5,1,1,1,1,1,5,3,5,1,3,5,3,1, + 1,1,1,3,7,3,7,5,7,1,5,5,7,5,3,3,7,5,3,1,1,3,1,3,1,1,3,7,1,7, + 1,1,5,1,7,5,3,7,3,5,3,1,1,5,5,1,7,7,3,7,3,7,1,5,1,5,3,7,3,5, + 7,7,7,3,3,1,1,5,5,3,7,1,1,1,3,5,3,1,1,3,3,7,5,1,1,3,7,1,5,7, + 3,7,5,5,7,3,5,3,1,5,3,1,1,7,5,1,7,3,7,5,1,7,1,7,7,1,1,7,1,5, + 5,1,1,7,5,7,1,5,3,5,3,3,7,1,5,1,1,5,5,3,3,7,5,5,1,1,1,3,1,5, + 7,7,1,7,5,7,3,7,3,1,3,7,3,1,5,5,3,5,1,3,5,5,5,1,1,7,7,1,5,5, + 1,3,5,1,5,3,5,3,3,7,5,7,3,7,3,1,3,7,7,3,3,1,1,3,3,3,3,3,5,5, + 3,3,3,1,3,5,7,7,1,5,7,3,7,1,1,3,5,7,5,3,3,3/ DATA (VINIT(I,4),I=6,357)/1,7,9,13,11,1,3,7,9,5,13,13,11,3,15,5,3, + 15,7,9,13,9,1,11,7,5,15,1,15,11,5,11,1,7,9,7,7,1,15,15,15,13, + 3,3,15,5,9,7,13,3,7,5,11,9,1,9,1,5,7,13,9,9,1,7,3,5,1,11,11, + 13,7,7,9,9,1,1,3,9,15,1,5,13,1,9,9,9,9,9,13,11,3,5,11,11,13, + 5,3,15,1,11,11,7,13,15,11,13,9,11,15,15,13,3,15,7,9,11,13,11, + 9,9,5,13,9,1,13,7,7,7,7,7,5,9,7,13,11,9,11,15,3,13,11,1,11,3, + 3,9,11,1,7,1,15,15,3,1,9,1,7,13,11,3,13,11,7,3,3,5,13,11,5, + 11,1,3,9,7,15,7,5,13,7,9,13,15,13,9,7,15,7,9,5,11,11,13,13,9, + 3,5,13,9,11,15,11,7,1,7,13,3,13,3,13,9,15,7,13,13,3,13,15,15, + 11,9,13,9,15,1,1,15,11,11,7,1,11,13,9,13,3,5,11,13,9,9,13,1, + 11,15,13,3,13,7,15,1,15,3,3,11,7,13,7,7,9,7,5,15,9,5,5,7,15, + 13,15,5,15,5,3,1,11,7,1,5,7,9,3,11,1,15,1,3,15,11,13,5,13,1, + 7,1,15,7,5,1,1,15,13,11,11,13,5,11,7,9,7,1,5,3,9,5,5,11,5,1, + 7,1,11,7,9,13,15,13,3,1,11,13,15,1,1,11,9,13,3,13,11,15,13,9, + 9,9,5,5,5,5,1,15,5,9/ DATA (VINIT(I,4),I=358,710)/11,7,15,5,3,13,5,3,11,5,1,11,13,9,11, + 3,7,13,15,1,7,11,1,13,1,15,1,9,7,3,9,11,1,9,13,13,3,11,7,9,1, + 7,15,9,1,5,13,5,11,3,9,15,11,13,5,1,7,7,5,13,7,7,9,5,11,11,1, + 1,15,3,13,9,13,9,9,11,5,5,13,15,3,9,15,3,11,11,15,15,3,11,15, + 15,3,1,3,1,3,3,1,3,13,1,11,5,15,7,15,9,1,7,1,9,11,15,1,13,9, + 13,11,7,3,7,3,13,7,9,7,7,3,3,9,9,7,5,11,13,13,7,7,15,9,5,5,3, + 3,13,3,9,3,1,11,1,3,11,15,11,11,11,9,13,7,9,15,9,11,1,3,3,9, + 7,15,13,13,7,15,9,13,9,15,13,15,9,13,1,11,7,11,3,13,5,1,7,15, + 3,13,7,13,13,11,3,5,3,13,11,9,9,3,11,11,7,9,13,11,7,15,13,7, + 5,3,1,5,15,15,3,11,1,7,3,15,11,5,5,3,5,5,1,15,5,1,5,3,7,5,11, + 3,13,9,13,15,5,3,5,9,5,3,11,1,13,9,15,3,5,11,9,1,3,15,9,9,9, + 11,7,5,13,1,15,3,13,9,13,5,1,5,1,13,13,7,7,1,9,5,11,9,11,13, + 3,15,15,13,15,7,5,7,9,7,9,9,9,11,9,3,11,15,13,13,5,9,15,1,1, + 9,5,13,3,13,15,3,1,3,11,13,1,15,9,9,3,1,9,1,9,1,13,11,15,7, + 11,15,13,15,1,9,9,7/ DATA (VINIT(I,4),I=711,1065)/3,5,11,7,3,9,5,15,7,5,3,13,7,1,1,9, + 15,15,15,11,3,5,15,13,7,15,15,11,11,9,5,15,9,7,3,13,1,1,5,1, + 3,1,7,1,1,5,1,11,11,9,9,5,13,7,7,7,1,1,9,9,11,11,15,7,5,5,3, + 11,1,3,7,13,7,7,7,3,15,15,11,9,3,9,3,15,13,5,3,3,3,5,9,15,9, + 9,1,5,9,9,15,5,15,7,9,1,9,9,5,11,5,15,15,11,7,7,7,1,1,11,11, + 13,15,3,13,5,1,7,1,11,3,13,15,3,5,3,5,7,3,9,9,5,1,7,11,9,3,5, + 11,13,13,13,9,15,5,7,1,15,11,9,15,15,13,13,13,1,11,9,15,9,5, + 15,5,7,3,11,3,15,7,13,11,7,3,7,13,5,13,15,5,13,9,1,15,11,5,5, + 1,11,3,3,7,1,9,7,15,9,9,3,11,15,7,1,3,1,1,1,9,1,5,15,15,7,5, + 5,7,9,7,15,13,13,11,1,9,11,1,13,1,7,15,15,5,5,1,11,3,9,11,9, + 9,9,1,9,3,5,15,1,1,9,7,3,3,1,9,9,11,9,9,13,13,3,13,11,13,5,1, + 5,5,9,9,3,13,13,9,15,9,11,7,11,9,13,9,1,15,9,7,7,1,7,9,9,15, + 1,11,1,13,13,15,9,13,7,15,3,9,3,1,13,7,5,9,3,1,7,1,1,13,3,3, + 11,1,7,13,15,15,5,7,13,13,15,11,13,1,13,13,3,9,15,15,11,15,9, + 15,1,13,15,1,1,5/ DATA (VINIT(I,4),I=1066,1111)/11,5,1,11,11,5,3,9,1,3,5,13,9,7,7,1, + 9,9,15,7,5,5,15,13,9,7,13,3,13,11,13,7,9,13,13,13,15,9,5,5,3, + 3,3,1,3,15/ DATA (VINIT(I,5),I=8,331)/9,3,27,15,29,21,23,19,11,25,7,13,17,1, + 25,29,3,31,11,5,23,27,19,21,5,1,17,13,7,15,9,31,25,3,5,23,7, + 3,17,23,3,3,21,25,25,23,11,19,3,11,31,7,9,5,17,23,17,17,25, + 13,11,31,27,19,17,23,7,5,11,19,19,7,13,21,21,7,9,11,1,5,21, + 11,13,25,9,7,7,27,15,25,15,21,17,19,19,21,5,11,3,5,29,31,29, + 5,5,1,31,27,11,13,1,3,7,11,7,3,23,13,31,17,1,27,11,25,1,23, + 29,17,25,7,25,27,17,13,17,23,5,17,5,13,11,21,5,11,5,9,31,19, + 17,9,9,27,21,15,15,1,1,29,5,31,11,17,23,19,21,25,15,11,5,5,1, + 19,19,19,7,13,21,17,17,25,23,19,23,15,13,5,19,25,9,7,3,21,17, + 25,1,27,25,27,25,9,13,3,17,25,23,9,25,9,13,17,17,3,15,7,7,29, + 3,19,29,29,19,29,13,15,25,27,1,3,9,9,13,31,29,31,5,15,29,1, + 19,5,9,19,5,15,3,5,7,15,17,17,23,11,9,23,19,3,17,1,27,9,9,17, + 13,25,29,23,29,11,31,25,21,29,19,27,31,3,5,3,3,13,21,9,29,3, + 17,11,11,9,21,19,7,17,31,25,1,27,5,15,27,29,29,29,25,27,25,3, + 21,17,25,13,15,17,13,23,9,3,11,7,9,9,7,17,7,1/ DATA (VINIT(I,5),I=332,654)/27,1,9,5,31,21,25,25,21,11,1,23,19,27, + 15,3,5,23,9,25,7,29,11,9,13,5,11,1,3,31,27,3,17,27,11,13,15, + 29,15,1,15,23,25,13,21,15,3,29,29,5,25,17,11,7,15,5,21,7,31, + 13,11,23,5,7,23,27,21,29,15,7,27,27,19,7,15,27,27,19,19,9,15, + 1,3,29,29,5,27,31,9,1,7,3,19,19,29,9,3,21,31,29,25,1,3,9,27, + 5,27,25,21,11,29,31,27,21,29,17,9,17,13,11,25,15,21,11,19,31, + 3,19,5,3,3,9,13,13,3,29,7,5,9,23,13,21,23,21,31,11,7,7,3,23, + 1,23,5,9,17,21,1,17,29,7,5,17,13,25,17,9,19,9,5,7,21,19,13,9, + 7,3,9,3,15,31,29,29,25,13,9,21,9,31,7,15,5,31,7,15,27,25,19, + 9,9,25,25,23,1,9,7,11,15,19,15,27,17,11,11,31,13,25,25,9,7, + 13,29,19,5,19,31,25,13,25,15,5,9,29,31,9,29,27,25,27,11,17,5, + 17,3,23,15,9,9,17,17,31,11,19,25,13,23,15,25,21,31,19,3,11, + 25,7,15,19,7,5,3,13,13,1,23,5,25,11,25,15,13,21,11,23,29,5, + 17,27,9,19,15,5,29,23,19,1,27,3,23,21,19,27,11,17,13,27,11, + 31,23,5,9,21,31,29,11,21,17,15,7,15,7,9,21,27,25/ DATA (VINIT(I,5),I=655,975)/29,11,3,21,13,23,19,27,17,29,25,17,9, + 1,19,23,5,23,1,17,17,13,27,23,7,7,11,13,17,13,11,21,13,23,1, + 27,13,9,7,1,27,29,5,13,25,21,3,31,15,13,3,19,13,1,27,15,17,1, + 3,13,13,13,31,29,27,7,7,21,29,15,17,17,21,19,17,3,15,5,27,27, + 3,31,31,7,21,3,13,11,17,27,25,1,9,7,29,27,21,23,13,25,29,15, + 17,29,9,15,3,21,15,17,17,31,9,9,23,19,25,3,1,11,27,29,1,31, + 29,25,29,1,23,29,25,13,3,31,25,5,5,11,3,21,9,23,7,11,23,11,1, + 1,3,23,25,23,1,23,3,27,9,27,3,23,25,19,29,29,13,27,5,9,29,29, + 13,17,3,23,19,7,13,3,19,23,5,29,29,13,13,5,19,5,17,9,11,11, + 29,27,23,19,17,25,13,1,13,3,11,1,17,29,1,13,17,9,17,21,1,11, + 1,1,25,5,7,29,29,19,19,1,29,13,3,1,31,15,13,3,1,11,19,5,29, + 13,29,23,3,1,31,13,19,17,5,5,1,29,23,3,19,25,19,27,9,27,13, + 15,29,23,13,25,25,17,19,17,15,27,3,25,17,27,3,27,31,23,13,31, + 11,15,7,21,19,27,19,21,29,7,31,13,9,9,7,21,13,11,9,11,29,19, + 11,19,21,5,29,13,7,19,19,27,23,31,1,27,21,7,3,7,11/ DATA (VINIT(I,5),I=976,1111)/23,13,29,11,31,19,1,5,5,11,5,3,27,5, + 7,11,31,1,27,31,31,23,5,21,27,9,25,3,15,19,1,19,9,5,25,21,15, + 25,29,15,21,11,19,15,3,7,13,11,25,17,1,5,31,13,29,23,9,5,29, + 7,17,27,7,17,31,9,31,9,9,7,21,3,3,3,9,11,21,11,31,9,25,5,1, + 31,13,29,9,29,1,11,19,7,27,13,31,7,31,7,25,23,21,29,11,11,13, + 11,27,1,23,31,21,23,21,19,31,5,31,25,25,19,17,11,25,7,13,1, + 29,17,23,15,7,29,17,13,3,17/ DATA (VINIT(I,6),I=14,324)/37,33,7,5,11,39,63,59,17,15,23,29,3,21, + 13,31,25,9,49,33,19,29,11,19,27,15,25,63,55,17,63,49,19,41, + 59,3,57,33,49,53,57,57,39,21,7,53,9,55,15,59,19,49,31,3,39,5, + 5,41,9,19,9,57,25,1,15,51,11,19,61,53,29,19,11,9,21,19,43,13, + 13,41,25,31,9,11,19,5,53,37,7,51,45,7,7,61,23,45,7,59,41,1, + 29,61,37,27,47,15,31,35,31,17,51,13,25,45,5,5,33,39,5,47,29, + 35,47,63,45,37,47,59,21,59,33,51,9,27,13,25,43,3,17,21,59,61, + 27,47,57,11,17,39,1,63,21,59,17,13,31,3,31,7,9,27,37,23,31,9, + 45,43,31,63,21,39,51,27,7,53,11,1,59,39,23,49,23,7,55,59,3, + 19,35,13,9,13,15,23,9,7,43,55,3,19,9,27,33,27,49,23,47,19,7, + 11,55,27,35,5,5,55,35,37,9,33,29,47,25,11,47,53,61,59,3,53, + 47,5,19,59,5,47,23,45,53,3,49,61,47,39,29,17,57,5,17,31,23, + 41,39,5,27,7,29,29,33,31,41,31,29,17,29,29,9,9,31,27,53,35,5, + 61,1,49,13,57,29,5,21,43,25,57,49,37,27,11,61,37,49,5,63,63, + 3,45,37,63,21,21,19,27,59,21,45,23,13,15,3,43,63,39,19/ DATA (VINIT(I,6),I=325,632)/63,31,41,41,15,43,63,53,1,63,31,7,17, + 11,61,31,51,37,29,59,25,63,59,47,15,27,19,29,45,35,55,39,19, + 43,21,19,13,17,51,37,5,33,35,49,25,45,1,63,47,9,63,15,25,25, + 15,41,13,3,19,51,49,37,25,49,13,53,47,23,35,29,33,21,35,23,3, + 43,31,63,9,1,61,43,3,11,55,11,35,1,63,35,49,19,45,9,57,51,1, + 47,41,9,11,37,19,55,23,55,55,13,7,47,37,11,43,17,3,25,19,55, + 59,37,33,43,1,5,21,5,63,49,61,21,51,15,19,43,47,17,9,53,45, + 11,51,25,11,25,47,47,1,43,29,17,31,15,59,27,63,11,41,51,29,7, + 27,63,31,43,3,29,39,3,59,59,1,53,63,23,63,47,51,23,61,39,47, + 21,39,15,3,9,57,61,39,37,21,51,1,23,43,27,25,11,13,21,43,7, + 11,33,55,1,37,35,27,61,39,5,19,61,61,57,59,21,59,61,57,25,55, + 27,31,41,33,63,19,57,35,13,63,35,17,11,11,49,41,55,5,45,17, + 35,5,31,31,37,17,45,51,1,39,49,55,19,41,13,5,51,5,49,1,21,13, + 17,59,51,11,3,61,1,33,37,33,61,25,27,59,7,49,13,63,3,33,3,15, + 9,13,35,39,11,59,59,1,57,11,5,57,13,31,13,11,55,45,9,55,55/ DATA (VINIT(I,6),I=633,942)/19,25,41,23,45,29,63,59,27,39,21,37,7, + 61,49,35,39,9,29,7,25,23,57,5,19,15,33,49,37,25,17,45,29,15, + 25,3,3,49,11,39,15,19,57,39,15,11,3,57,31,55,61,19,5,41,35, + 59,61,39,41,53,53,63,31,9,59,13,35,55,41,49,5,41,25,27,43,5, + 5,43,5,5,17,5,15,27,29,17,9,3,55,31,1,45,45,13,57,17,3,61,15, + 49,15,47,9,37,45,9,51,61,21,33,11,21,63,63,47,57,61,49,9,59, + 19,29,21,23,55,23,43,41,57,9,39,27,41,35,61,29,57,63,21,31, + 59,35,49,3,49,47,49,33,21,19,21,35,11,17,37,23,59,13,37,35, + 55,57,1,29,45,11,1,15,9,33,19,53,43,39,23,7,13,13,1,19,41,55, + 1,13,15,59,55,15,3,57,37,31,17,1,3,21,29,25,55,9,37,33,53,41, + 51,19,57,13,63,43,19,7,13,37,33,19,15,63,51,11,49,23,57,47, + 51,15,53,41,1,15,37,61,11,35,29,33,23,55,11,59,19,61,61,45, + 13,49,13,63,5,61,5,31,17,61,63,13,27,57,1,21,5,11,39,57,51, + 53,39,25,41,39,37,23,31,25,33,17,57,29,27,23,47,41,29,19,47, + 41,25,5,51,43,39,29,7,31,45,51,49,55,17,43,49,45,9,29,3,5,47, + 9,15,19/ DATA (VINIT(I,6),I=943,1111)/51,45,57,63,9,21,59,3,9,13,45,23,15, + 31,21,15,51,35,9,11,61,23,53,29,51,45,31,29,5,35,29,53,35,17, + 59,55,27,51,59,27,47,15,29,37,7,49,55,5,19,45,29,19,57,33,53, + 45,21,9,3,35,29,43,31,39,3,45,1,41,29,5,59,41,33,35,27,19,13, + 25,27,43,33,35,17,17,23,7,35,15,61,61,53,5,15,23,11,13,43,55, + 47,25,43,15,57,45,1,49,63,57,15,31,31,7,53,27,15,47,23,7,29, + 53,47,9,53,3,25,55,45,63,21,17,23,31,27,27,43,63,55,63,45,51, + 15,27,5,37,43,11,27,5,27,59,21,7,39,27,63,35,47,55,17,17,17, + 3,19,21,13,49,61,39,15/ DATA (VINIT(I,7),I=20,305)/13,33,115,41,79,17,29,119,75,73,105,7, + 59,65,21,3,113,61,89,45,107,21,71,79,19,71,61,41,57,121,87, + 119,55,85,121,119,11,23,61,11,35,33,43,107,113,101,29,87,119, + 97,29,17,89,5,127,89,119,117,103,105,41,83,25,41,55,69,117, + 49,127,29,1,99,53,83,15,31,73,115,35,21,89,5,1,91,53,35,95, + 83,19,85,55,51,101,33,41,55,45,95,61,27,37,89,75,57,61,15, + 117,15,21,27,25,27,123,39,109,93,51,21,91,109,107,45,15,93, + 127,3,53,81,79,107,79,87,35,109,73,35,83,107,1,51,7,59,33, + 115,43,111,45,121,105,125,87,101,41,95,75,1,57,117,21,27,67, + 29,53,117,63,1,77,89,115,49,127,15,79,81,29,65,103,33,73,79, + 29,21,113,31,33,107,95,111,59,99,117,63,63,99,39,9,35,63,125, + 99,45,93,33,93,9,105,75,51,115,11,37,17,41,21,43,73,19,93,7, + 95,81,93,79,81,55,9,51,63,45,89,73,19,115,39,47,81,39,5,5,45, + 53,65,49,17,105,13,107,5,5,19,73,59,43,83,97,115,27,1,69,103, + 3,99,103,63,67,25,121,97,77,13,83,103,41,11,27,81,37,33,125, + 71,41,41,59,41,87,123/ DATA (VINIT(I,7),I=306,589)/43,101,63,45,39,21,97,15,97,111,21,49, + 13,17,79,91,65,105,75,1,45,67,83,107,125,87,15,81,95,105,65, + 45,59,103,23,103,99,67,99,47,117,71,89,35,53,73,9,115,49,37, + 1,35,9,45,81,19,127,17,17,105,89,49,101,7,37,33,11,95,95,17, + 111,105,41,115,5,69,101,27,27,101,103,53,9,21,43,79,91,65, + 117,87,125,55,45,63,85,83,97,45,83,87,113,93,95,5,17,77,77, + 127,123,45,81,85,121,119,27,85,41,49,15,107,21,51,119,11,87, + 101,115,63,63,37,121,109,7,43,69,19,77,49,71,59,35,7,13,55, + 101,127,103,85,109,29,61,67,21,111,67,23,57,75,71,101,123,41, + 107,101,107,125,27,47,119,41,19,127,33,31,109,7,91,91,39,125, + 105,47,125,123,91,9,103,45,23,117,9,125,73,11,37,61,79,21,5, + 47,117,67,53,85,33,81,121,47,61,51,127,29,65,45,41,95,57,73, + 33,117,61,111,59,123,65,47,105,23,29,107,37,81,67,29,115,119, + 75,73,99,103,7,57,45,61,95,49,101,101,35,47,119,39,67,31,103, + 7,61,127,87,3,35,29,73,95,103,71,75,51,87,57,97,11,105,87,41, + 73,109,69,35,121,39,111,1,77/ DATA (VINIT(I,7),I=590,875)/39,47,53,91,3,17,51,83,39,125,85,111, + 21,69,85,29,55,11,117,1,47,17,65,63,47,117,17,115,51,25,33, + 123,123,83,51,113,95,121,51,91,109,43,55,35,55,87,33,37,5,3, + 45,21,105,127,35,17,35,37,97,97,21,77,123,17,89,53,105,75,25, + 125,13,47,21,125,23,55,63,61,5,17,93,57,121,69,73,93,121,105, + 75,91,67,95,75,9,69,97,99,93,11,53,19,73,5,33,79,107,65,69, + 79,125,25,93,55,61,17,117,69,97,87,111,37,93,59,79,95,53,115, + 53,85,85,65,59,23,75,21,67,27,99,79,27,3,95,27,69,19,75,47, + 59,41,85,77,99,55,49,93,93,119,51,125,63,13,15,45,61,19,105, + 115,17,83,7,7,11,61,37,63,89,95,119,113,67,123,91,33,37,99, + 43,11,33,65,81,79,81,107,63,63,55,89,91,25,93,101,27,55,75, + 121,79,43,125,73,27,109,35,21,71,113,89,59,95,41,45,113,119, + 113,39,59,73,15,13,59,67,121,27,7,105,15,59,59,35,91,89,23, + 125,97,53,41,91,111,29,31,3,103,61,71,35,7,119,29,45,49,111, + 41,109,59,125,13,27,19,79,9,75,83,81,33,91,109,33,29,107,111, + 101,107,109,65,59,43,37/ DATA (VINIT(I,7),I=876,1111)/1,9,15,109,37,111,113,119,79,73,65, + 71,93,17,101,87,97,43,23,75,109,41,49,53,31,97,105,109,119, + 51,9,53,113,97,73,89,79,49,61,105,13,99,53,71,7,87,21,101,5, + 71,31,123,121,121,73,79,115,13,39,101,19,37,51,83,97,55,81, + 91,127,105,89,63,47,49,75,37,77,15,49,107,23,23,35,19,69,17, + 59,63,73,29,125,61,65,95,101,81,57,69,83,37,11,37,95,1,73,27, + 29,57,7,65,83,99,69,19,103,43,95,25,19,103,41,125,97,71,105, + 83,83,61,39,9,45,117,63,31,5,117,67,125,41,117,43,77,97,15, + 29,5,59,25,63,87,39,39,77,85,37,81,73,89,29,125,109,21,23, + 119,105,43,93,97,15,125,29,51,69,37,45,31,75,109,119,53,5, + 101,125,121,35,29,7,63,17,63,13,69,15,105,51,127,105,9,57,95, + 59,109,35,49,23,33,107,55,33,57,79,73,69,59,107,55,11,63,95, + 103,23,125,91,31,91,51,65,61,75,69,107,65,101,59,35,15/ DATA (VINIT(I,8),I=38,299)/7,23,39,217,141,27,53,181,169,35,15, + 207,45,247,185,117,41,81,223,151,81,189,61,95,185,23,73,113, + 239,85,9,201,83,53,183,203,91,149,101,13,111,239,3,205,253, + 247,121,189,169,179,197,175,217,249,195,95,63,19,7,5,75,217, + 245,111,189,165,169,141,221,249,159,253,207,249,219,23,49, + 127,237,5,25,177,37,103,65,167,81,87,119,45,79,143,57,79,187, + 143,183,75,97,211,149,175,37,135,189,225,241,63,33,43,13,73, + 213,57,239,183,117,21,29,115,43,205,223,15,3,159,51,101,127, + 99,239,171,113,171,119,189,245,201,27,185,229,105,153,189,33, + 35,137,77,97,17,181,55,197,201,155,37,197,137,223,25,179,91, + 23,235,53,253,49,181,249,53,173,97,247,67,115,103,159,239,69, + 173,217,95,221,247,97,91,123,223,213,129,181,87,239,85,89, + 249,141,39,57,249,71,101,159,33,137,189,71,253,205,171,13, + 249,109,131,199,189,179,31,99,113,41,173,23,189,197,3,135,9, + 95,195,27,183,1,123,73,53,99,197,59,27,101,55,193,31,61,119, + 11,7,255,233,53,157,193,97,83,65,81,239,167,69,71,109/ DATA (VINIT(I,8),I=300,559)/97,137,71,193,189,115,79,205,37,227, + 53,33,91,229,245,105,77,229,161,103,93,13,161,229,223,69,15, + 25,23,233,93,25,217,247,61,75,27,9,223,213,55,197,145,89,199, + 41,201,5,149,35,119,183,53,11,13,3,179,229,43,55,187,233,47, + 133,91,47,71,93,105,145,45,255,221,115,175,19,129,5,209,197, + 57,177,115,187,119,77,211,111,33,113,23,87,137,41,7,83,43, + 121,145,5,219,27,11,111,207,55,97,63,229,53,33,149,23,187, + 153,91,193,183,59,211,93,139,59,179,163,209,77,39,111,79,229, + 85,237,199,137,147,25,73,121,129,83,87,93,205,167,53,107,229, + 213,95,219,109,175,13,209,97,61,147,19,13,123,73,35,141,81, + 19,171,255,111,107,233,113,133,89,9,231,95,69,33,1,253,219, + 253,247,129,11,251,221,153,35,103,239,7,27,235,181,5,207,53, + 149,155,225,165,137,155,201,97,245,203,47,39,35,105,239,49, + 15,253,7,237,213,55,87,199,27,175,49,41,229,85,3,149,179,129, + 185,249,197,15,97,197,139,203,63,33,251,217,199,199,99,249, + 33,229,177,13,209,147,97,31,125,177,137/ DATA (VINIT(I,8),I=560,819)/187,11,91,223,29,169,231,59,31,163,41, + 57,87,247,25,127,101,207,187,73,61,105,27,91,171,243,33,3,1, + 21,229,93,71,61,37,183,65,211,53,11,151,165,47,5,129,79,101, + 147,169,181,19,95,77,139,197,219,97,239,183,143,9,13,209,23, + 215,53,137,203,19,151,171,133,219,231,3,15,253,225,33,111, + 183,213,169,119,111,15,201,123,121,225,113,113,225,161,165,1, + 139,55,3,93,217,193,97,29,69,231,161,93,69,143,137,9,87,183, + 113,183,73,215,137,89,251,163,41,227,145,57,81,57,11,135,145, + 161,175,159,25,55,167,157,211,97,247,249,23,129,159,71,197, + 127,141,219,5,233,131,217,101,131,33,157,173,69,207,239,81, + 205,11,41,169,65,193,77,201,173,1,221,157,1,15,113,147,137, + 205,225,73,45,49,149,113,253,99,17,119,105,117,129,243,75, + 203,53,29,247,35,247,171,31,199,213,29,251,7,251,187,91,11, + 149,13,205,37,249,137,139,9,7,113,183,205,187,39,3,79,155, + 227,89,185,51,127,63,83,41,133,183,181,127,19,255,219,59,251, + 3,187,57,217,115,217,229,181,185,149,83,115,11/ DATA (VINIT(I,8),I=820,1074)/123,19,109,165,103,123,219,129,155, + 207,177,9,49,181,231,33,233,67,155,41,9,95,123,65,117,249,85, + 169,129,241,173,251,225,147,165,69,81,239,95,23,83,227,249, + 143,171,193,9,21,57,73,97,57,29,239,151,159,191,47,51,1,223, + 251,251,151,41,119,127,131,33,209,123,53,241,25,31,183,107, + 25,115,39,11,213,239,219,109,185,35,133,123,185,27,55,245,61, + 75,205,213,169,163,63,55,49,83,195,51,31,41,15,203,41,63,127, + 161,5,143,7,199,251,95,75,101,15,43,237,197,117,167,155,21, + 83,205,255,49,101,213,237,135,135,21,73,93,115,7,85,223,237, + 79,89,5,57,239,67,65,201,155,71,85,195,89,181,119,135,147, + 237,173,41,155,67,113,111,21,183,23,103,207,253,69,219,205, + 195,43,197,229,139,177,129,69,97,201,163,189,11,99,91,253, + 239,91,145,19,179,231,121,7,225,237,125,191,119,59,175,237, + 131,79,43,45,205,199,251,153,207,37,179,113,255,107,217,61,7, + 181,247,31,13,113,145,107,233,233,43,79,23,169,137,129,183, + 53,91,55,103,223,87,177,157,79,213,139/ DATA (VINIT(I,8),I=1075,1111)/183,231,205,143,129,243,205,93,59, + 15,89,9,11,47,133,227,75,9,91,19,171,163,79,7,103,5,119,155, + 75,11,71,95,17,13,243,207,187/ DATA (VINIT(I,9),I=54,299)/235,307,495,417,57,151,19,119,375,451, + 55,449,501,53,185,317,17,21,487,13,347,393,15,391,307,189, + 381,71,163,99,467,167,433,337,257,179,47,385,23,117,369,425, + 207,433,301,147,333,85,221,423,49,3,43,229,227,201,383,281, + 229,207,21,343,251,397,173,507,421,443,399,53,345,77,385,317, + 155,187,269,501,19,169,235,415,61,247,183,5,257,401,451,95, + 455,49,489,75,459,377,87,463,155,233,115,429,211,419,143,487, + 195,209,461,193,157,193,363,181,271,445,381,231,135,327,403, + 171,197,181,343,113,313,393,311,415,267,247,425,233,289,55, + 39,247,327,141,5,189,183,27,337,341,327,87,429,357,265,251, + 437,201,29,339,257,377,17,53,327,47,375,393,369,403,125,429, + 257,157,217,85,267,117,337,447,219,501,41,41,193,509,131,207, + 505,421,149,111,177,167,223,291,91,29,305,151,177,337,183, + 361,435,307,507,77,181,507,315,145,423,71,103,493,271,469, + 339,237,437,483,31,219,61,131,391,233,219,69,57,459,225,421, + 7,461,111,451,277,185,193,125,251,199,73,71,7,409,417,149/ DATA (VINIT(I,9),I=300,550)/193,53,437,29,467,229,31,35,75,105, + 503,75,317,401,367,131,365,441,433,93,377,405,465,259,283, + 443,143,445,3,461,329,309,77,323,155,347,45,381,315,463,207, + 321,157,109,479,313,345,167,439,307,235,473,79,101,245,19, + 381,251,35,25,107,187,115,113,321,115,445,61,77,293,405,13, + 53,17,171,299,41,79,3,485,331,13,257,59,201,497,81,451,199, + 171,81,253,365,75,451,149,483,81,453,469,485,305,163,401,15, + 91,3,129,35,239,355,211,387,101,299,67,375,405,357,267,363, + 79,83,437,457,39,97,473,289,179,57,23,49,79,71,341,287,95, + 229,271,475,49,241,261,495,353,381,13,291,37,251,105,399,81, + 89,265,507,205,145,331,129,119,503,249,1,289,463,163,443,63, + 123,361,261,49,429,137,355,175,507,59,277,391,25,185,381,197, + 39,5,429,119,247,177,329,465,421,271,467,151,45,429,137,471, + 11,17,409,347,199,463,177,11,51,361,95,497,163,351,127,395, + 511,327,353,49,105,151,321,331,329,509,107,109,303,467,287, + 161,45,385,289,363,331,265,407,37,433,315,343,63,51,185,71, + 27,267/ DATA (VINIT(I,9),I=551,798)/503,239,293,245,281,297,75,461,371, + 129,189,189,339,287,111,111,379,93,27,185,347,337,247,507, + 161,231,43,499,73,327,263,331,249,493,37,25,115,3,167,197, + 127,357,497,103,125,191,165,55,101,95,79,351,341,43,125,135, + 173,289,373,133,421,241,281,213,177,363,151,227,145,363,239, + 431,81,397,241,67,291,255,405,421,399,75,399,105,329,41,425, + 7,283,375,475,427,277,209,411,3,137,195,289,509,121,55,147, + 275,251,19,129,285,415,487,491,193,219,403,23,97,65,285,75, + 21,373,261,339,239,495,415,333,107,435,297,213,149,463,199, + 323,45,19,301,121,499,187,229,63,425,99,281,35,125,349,87, + 101,59,195,511,355,73,263,243,101,165,141,11,389,219,187,449, + 447,393,477,305,221,51,355,209,499,479,265,377,145,411,173, + 11,433,483,135,385,341,89,209,391,33,395,319,451,119,341,227, + 375,61,331,493,411,293,47,203,375,167,395,155,5,237,361,489, + 127,21,345,101,371,233,431,109,119,277,125,263,73,135,123,83, + 123,405,69,75,287,401,23,283,393,41,379,431,11,475,505,19, + 365,265,271/ DATA (VINIT(I,9),I=799,1045)/499,489,443,165,91,83,291,319,199, + 107,245,389,143,137,89,125,281,381,215,131,299,249,375,455, + 43,73,281,217,297,229,431,357,81,357,171,451,481,13,387,491, + 489,439,385,487,177,393,33,71,375,443,129,407,395,127,65,333, + 309,119,197,435,497,373,71,379,509,387,159,265,477,463,449, + 47,353,249,335,505,89,141,55,235,187,87,363,93,363,101,67, + 215,321,331,305,261,411,491,479,65,307,469,415,131,315,487, + 83,455,19,113,163,503,99,499,251,239,81,167,391,255,317,363, + 359,395,419,307,251,267,171,461,183,465,165,163,293,477,223, + 403,389,97,335,357,297,19,469,501,249,85,213,311,265,379,297, + 283,393,449,463,289,159,289,499,407,129,137,221,43,89,403, + 271,75,83,445,453,389,149,143,423,499,317,445,157,137,453, + 163,87,23,391,119,427,323,173,89,259,377,511,249,31,363,229, + 353,329,493,427,57,205,389,91,83,13,219,439,45,35,371,441,17, + 267,501,53,25,333,17,201,475,257,417,345,381,377,55,403,77, + 389,347,363,211,413,419,5,167,219,201,285,425,11,77,269,489, + 281,403,79/ DATA (VINIT(I,9),I=1046,1111)/425,125,81,331,437,271,397,299,475, + 271,249,413,233,261,495,171,69,27,409,21,421,367,81,483,255, + 15,219,365,497,181,75,431,99,325,407,229,281,63,83,493,5,113, + 15,271,37,87,451,299,83,451,311,441,47,455,47,253,13,109,369, + 347,11,409,275,63,441,15/ DATA (VINIT(I,10),I=102,344)/519,307,931,1023,517,771,151,1023, + 539,725,45,927,707,29,125,371,275,279,817,389,453,989,1015, + 29,169,743,99,923,981,181,693,309,227,111,219,897,377,425, + 609,227,19,221,143,581,147,919,127,725,793,289,411,835,921, + 957,443,349,813,5,105,457,393,539,101,197,697,27,343,515,69, + 485,383,855,693,133,87,743,747,475,87,469,763,721,345,479, + 965,527,121,271,353,467,177,245,627,113,357,7,691,725,355, + 889,635,737,429,545,925,357,873,187,351,677,999,921,477,233, + 765,495,81,953,479,89,173,473,131,961,411,291,967,65,511,13, + 805,945,369,827,295,163,835,259,207,331,29,315,999,133,967, + 41,117,677,471,717,881,755,351,723,259,879,455,721,289,149, + 199,805,987,851,423,597,129,11,733,549,153,285,451,559,377, + 109,357,143,693,615,677,701,475,767,85,229,509,547,151,389, + 711,785,657,319,509,99,1007,775,359,697,677,85,497,105,615, + 891,71,449,835,609,377,693,665,627,215,911,503,729,131,19, + 895,199,161,239,633,1013,537,255,23,149,679,1021,595,199,557, + 659,251,829,727,439,495,647,223/ DATA (VINIT(I,10),I=345,586)/949,625,87,481,85,799,917,769,949, + 739,115,499,945,547,225,1015,469,737,495,353,103,17,665,639, + 525,75,447,185,43,729,577,863,735,317,99,17,477,893,537,519, + 1017,375,297,325,999,353,343,729,135,489,859,267,141,831,141, + 893,249,807,53,613,131,547,977,131,999,175,31,341,739,467, + 675,241,645,247,391,583,183,973,433,367,131,467,571,309,385, + 977,111,917,935,473,345,411,313,97,149,959,841,839,669,431, + 51,41,301,247,1015,377,329,945,269,67,979,581,643,823,557,91, + 405,117,801,509,347,893,303,227,783,555,867,99,703,111,797, + 873,541,919,513,343,319,517,135,871,917,285,663,301,15,763, + 89,323,757,317,807,309,1013,345,499,279,711,915,411,281,193, + 739,365,315,375,809,469,487,621,857,975,537,939,585,129,625, + 447,129,1017,133,83,3,415,661,53,115,903,49,79,55,385,261, + 345,297,199,385,617,25,515,275,849,401,471,377,661,535,505, + 939,465,225,929,219,955,659,441,117,527,427,515,287,191,33, + 389,197,825,63,417,949,35,571,9,131,609,439,95,19,569,893, + 451,397,971,801/ DATA (VINIT(I,10),I=587,824)/125,471,187,257,67,949,621,453,411, + 621,955,309,783,893,597,377,753,145,637,941,593,317,555,375, + 575,175,403,571,555,109,377,931,499,649,653,329,279,271,647, + 721,665,429,957,803,767,425,477,995,105,495,575,687,385,227, + 923,563,723,481,717,111,633,113,369,955,253,321,409,909,367, + 33,967,453,863,449,539,781,911,113,7,219,725,1015,971,1021, + 525,785,873,191,893,297,507,215,21,153,645,913,755,371,881, + 113,903,225,49,587,201,927,429,599,513,97,319,331,833,325, + 887,139,927,399,163,307,803,169,1019,869,537,907,479,335,697, + 479,353,769,787,1023,855,493,883,521,735,297,1011,991,879, + 855,591,415,917,375,453,553,189,841,339,211,601,57,765,745, + 621,209,875,639,7,595,971,263,1009,201,23,77,621,33,535,963, + 661,523,263,917,103,623,231,47,301,549,337,675,189,357,1005, + 789,189,319,721,1005,525,675,539,191,813,917,51,167,415,579, + 755,605,721,837,529,31,327,799,961,279,409,847,649,241,285, + 545,407,161,591,73,313,811,17,663,269,261,37,783,127,917,231, + 577,975,793/ DATA (VINIT(I,10),I=825,1065)/921,343,751,139,221,79,817,393,545, + 11,781,71,1,699,767,917,9,107,341,587,903,965,599,507,843, + 739,579,397,397,325,775,565,925,75,55,979,931,93,957,857,753, + 965,795,67,5,87,909,97,995,271,875,671,613,33,351,69,811,669, + 729,401,647,241,435,447,721,271,745,53,775,99,343,451,427, + 593,339,845,243,345,17,573,421,517,971,499,435,769,75,203, + 793,985,343,955,735,523,659,703,303,421,951,405,631,825,735, + 433,841,485,49,749,107,669,211,497,143,99,57,277,969,107,397, + 563,551,447,381,187,57,405,731,769,923,955,915,737,595,341, + 253,823,197,321,315,181,885,497,159,571,981,899,785,947,217, + 217,135,753,623,565,717,903,581,955,621,361,869,87,943,907, + 853,353,335,197,771,433,743,195,91,1023,63,301,647,205,485, + 927,1003,987,359,577,147,141,1017,701,273,89,589,487,859,343, + 91,847,341,173,287,1003,289,639,983,685,697,35,701,645,911, + 501,705,873,763,745,657,559,699,315,347,429,197,165,955,859, + 167,303,833,531,473,635,641,195,589,821,205,3,635,371,891, + 249,123/ DATA (VINIT(I,10),I=1066,1111)/77,623,993,401,525,427,71,655,951, + 357,851,899,535,493,323,1003,343,515,859,1017,5,423,315,1011, + 703,41,777,163,95,831,79,975,235,633,723,297,589,317,679,981, + 195,399,1003,121,501,155/ DATA (VINIT(I,11),I=162,376)/7,2011,1001,49,825,415,1441,383,1581, + 623,1621,1319,1387,619,839,217,75,1955,505,281,1629,1379,53, + 1111,1399,301,209,49,155,1647,631,129,1569,335,67,1955,1611, + 2021,1305,121,37,877,835,1457,669,1405,935,1735,665,551,789, + 1543,1267,1027,1,1911,163,1929,67,1975,1681,1413,191,1711, + 1307,401,725,1229,1403,1609,2035,917,921,1789,41,2003,187,67, + 1635,717,1449,277,1903,1179,363,1211,1231,647,1261,1029,1485, + 1309,1149,317,1335,171,243,271,1055,1601,1129,1653,205,1463, + 1681,1621,197,951,573,1697,1265,1321,1805,1235,1853,1307,945, + 1197,1411,833,273,1517,1747,1095,1345,869,57,1383,221,1713, + 335,1751,1141,839,523,1861,1105,389,1177,1877,805,93,1591, + 423,1835,99,1781,1515,1909,1011,303,385,1635,357,973,1781, + 1707,1363,1053,649,1469,623,1429,1241,1151,1055,503,921,3, + 349,1149,293,45,303,877,1565,1583,1001,663,1535,395,1141, + 1481,1797,643,1507,465,2027,1695,367,937,719,545,1991,83,819, + 239,1791,1461,1647,1501,1161,1629,139,1595,1921,1267,1415, + 509,347,777,1083,363,269,1015/ DATA (VINIT(I,11),I=377,589)/1809,1105,1429,1471,2019,381,2025, + 1223,827,1733,887,1321,803,1951,1297,1995,833,1107,1135,1181, + 1251,983,1389,1565,273,137,71,735,1005,933,67,1471,551,457, + 1667,1729,919,285,1629,1815,653,1919,1039,531,393,1411,359, + 221,699,1485,471,1357,1715,595,1677,153,1903,1281,215,781, + 543,293,1807,965,1695,443,1985,321,879,1227,1915,839,1945, + 1993,1165,51,557,723,1491,817,1237,947,1215,1911,1225,1965, + 1889,1503,1177,73,1767,303,177,1897,1401,321,921,217,1779, + 327,1889,333,615,1665,1825,1639,237,1205,361,129,1655,983, + 1089,1171,401,677,643,749,303,1407,1873,1579,1491,1393,1247, + 789,763,49,5,1607,1891,735,1557,1909,1765,1777,1127,813,695, + 97,731,1503,1751,333,769,865,693,377,1919,957,1359,1627,1039, + 1783,1065,1665,1917,1947,991,1997,841,459,221,327,1595,1881, + 1269,1007,129,1413,475,1105,791,1983,1359,503,691,659,691, + 343,1375,1919,263,1373,603,1383,297,781,145,285,767,1739, + 1715,715,317,1333,85,831,1615,81,1667,1467,1457,1453,1825, + 109,387,1207,2039,213,1351,1329,1173/ DATA (VINIT(I,11),I=590,802)/57,1769,951,183,23,451,1155,1551, + 2037,811,635,1671,1451,863,1499,1673,363,1029,1077,1525,277, + 1023,655,665,1869,1255,965,277,1601,329,1603,1901,395,65, + 1307,2029,21,1321,543,1569,1185,1905,1701,413,2041,1697,725, + 1417,1847,411,211,915,1891,17,1877,1699,687,1089,1973,1809, + 851,1495,1257,63,1323,1307,609,881,1543,177,617,1505,1747, + 1537,925,183,77,1723,1877,1703,397,459,521,257,1177,389,1947, + 1553,1583,1831,261,485,289,1281,1543,1591,1123,573,821,1065, + 1933,1373,2005,905,207,173,1573,1597,573,1883,1795,1499,1743, + 553,335,333,1645,791,871,1157,969,557,141,223,1129,1685,423, + 1069,391,99,95,1847,531,1859,1833,1833,341,237,1997,1799,409, + 431,1917,363,335,1039,1085,1657,1975,1527,1111,659,389,899, + 595,1439,1861,1979,1569,1087,1009,165,1895,1481,1583,29,1193, + 1673,1075,301,1081,1377,1747,1497,1103,1789,887,739,1577,313, + 1367,1299,1801,1131,1837,73,1865,1065,843,635,55,1655,913, + 1037,223,1871,1161,461,479,511,1721,1107,389,151,35,375,1099, + 937,1185,1701,769,639,1633/ DATA (VINIT(I,11),I=803,1018)/1609,379,1613,2031,685,289,975,671, + 1599,1447,871,647,99,139,1427,959,89,117,841,891,1959,223, + 1697,1145,499,1435,1809,1413,1445,1675,171,1073,1349,1545, + 2039,1027,1563,859,215,1673,1919,1633,779,411,1845,1477,1489, + 447,1545,351,1989,495,183,1639,1385,1805,1097,1249,1431,1571, + 591,697,1509,709,31,1563,165,513,1425,1299,1081,145,1841, + 1211,941,609,845,1169,1865,1593,347,293,1277,157,211,93,1679, + 1799,527,41,473,563,187,1525,575,1579,857,703,1211,647,709, + 981,285,697,163,981,153,1515,47,1553,599,225,1147,381,135, + 821,1965,609,1033,983,503,1117,327,453,2005,1257,343,1649, + 1199,599,1877,569,695,1587,1475,187,973,233,511,51,1083,665, + 1321,531,1875,1939,859,1507,1979,1203,1965,737,921,1565,1943, + 819,223,365,167,1705,413,1577,745,1573,655,1633,1003,91,1123, + 477,1741,1663,35,715,37,1513,815,941,1379,263,1831,1735,1111, + 1449,353,1941,1655,1349,877,285,1723,125,1753,985,723,175, + 439,791,1051,1261,717,1555,1757,1777,577,1583,1957,873,331, + 1163,313,1,1963,963,1905,821/ DATA (VINIT(I,11),I=1019,1111)/1677,185,709,545,1723,215,1885, + 1249,583,1803,839,885,485,413,1767,425,129,1035,329,1263, + 1881,1779,1565,359,367,453,707,1419,831,1889,887,1871,1869, + 747,223,1547,1799,433,1441,553,2021,1303,1505,1735,1619,1065, + 1161,2047,347,867,881,1447,329,781,1065,219,589,645,1257, + 1833,749,1841,1733,1179,1191,1025,1639,1955,1423,1685,1711, + 493,549,783,1653,397,895,233,759,1505,677,1449,1573,1297, + 1821,1691,791,289,1187,867,1535,575,183/ DATA (VINIT(I,12),I=338,545)/3915,97,3047,937,2897,953,127,1201, + 3819,193,2053,3061,3759,1553,2007,2493,603,3343,3751,1059, + 783,1789,1589,283,1093,3919,2747,277,2605,2169,2905,721,4069, + 233,261,1137,3993,3619,2881,1275,3865,1299,3757,1193,733,993, + 1153,2945,3163,3179,437,271,3493,3971,1005,2615,2253,1131, + 585,2775,2171,2383,2937,2447,1745,663,1515,3767,2709,1767, + 3185,3017,2815,1829,87,3341,793,2627,2169,1875,3745,367,3783, + 783,827,3253,2639,2955,3539,1579,2109,379,2939,3019,1999, + 2253,2911,3733,481,1767,1055,4019,4085,105,1829,2097,2379, + 1567,2713,737,3423,3941,2659,3961,1755,3613,1937,1559,2287, + 2743,67,2859,325,2601,1149,3259,2403,3947,2011,175,3389,3915, + 1315,2447,141,359,3609,3933,729,2051,1755,2149,2107,1741, + 1051,3681,471,1055,845,257,1559,1061,2803,2219,1315,1369, + 3211,4027,105,11,1077,2857,337,3553,3503,3917,2665,3823,3403, + 3711,2085,1103,1641,701,4095,2883,1435,653,2363,1597,767,869, + 1825,1117,1297,501,505,149,873,2673,551,1499,2793,3277,2143, + 3663,533,3991,575,1877,1009,3929,473,3009,2595,3249,675,3593/ DATA (VINIT(I,12),I=546,752)/2453,1567,973,595,1335,1715,589,85, + 2265,3069,461,1659,2627,1307,1731,1501,1699,3545,3803,2157, + 453,2813,2047,2999,3841,2361,1079,573,69,1363,1597,3427,2899, + 2771,1327,1117,1523,3521,2393,2537,1979,3179,683,2453,453, + 1227,779,671,3483,2135,3139,3381,3945,57,1541,3405,3381,2371, + 2879,1985,987,3017,3031,3839,1401,3749,2977,681,1175,1519, + 3355,907,117,771,3741,3337,1743,1227,3335,2755,1909,3603, + 2397,653,87,2025,2617,3257,287,3051,3809,897,2215,63,2043, + 1757,3671,297,3131,1305,293,3865,3173,3397,2269,3673,717, + 3041,3341,3595,3819,2871,3973,1129,513,871,1485,3977,2473, + 1171,1143,3063,3547,2183,3993,133,2529,2699,233,2355,231, + 3241,611,1309,3829,1839,1495,301,1169,1613,2673,243,3601, + 3669,2813,2671,2679,3463,2477,1795,617,2317,1855,1057,1703, + 1761,2515,801,1205,1311,473,3963,697,1221,251,381,3887,1761, + 3093,3721,2079,4085,379,3601,3845,433,1781,29,1897,1599,2163, + 75,3475,3957,1641,3911,2959,2833,1279,1099,403,799,2183,2699, + 1711,2037,727,289,1785,1575,3633,2367,1261,3953,1735,171, + 1959/ DATA (VINIT(I,12),I=753,960)/2867,859,2951,3211,15,1279,1323,599, + 1651,3951,1011,315,3513,3351,1725,3793,2399,287,4017,3571, + 1007,541,3115,429,1585,1285,755,1211,3047,915,3611,2697,2129, + 3669,81,3939,2437,915,779,3567,3701,2479,3807,1893,3927,2619, + 2543,3633,2007,3857,3837,487,1769,3759,3105,2727,3155,2479, + 1341,1657,2767,2541,577,2105,799,17,2871,3637,953,65,69,2897, + 3841,3559,4067,2335,3409,1087,425,2813,1705,1701,1237,821, + 1375,3673,2693,3925,1541,1871,2285,847,4035,1101,2029,855, + 2733,2503,121,2855,1069,3463,3505,1539,607,1349,575,2301, + 2321,1101,333,291,2171,4085,2173,2541,1195,925,4039,1379,699, + 1979,275,953,1755,1643,325,101,2263,3329,3673,3413,1977,2727, + 2313,1419,887,609,2475,591,2613,2081,3805,3435,2409,111,3557, + 3607,903,231,3059,473,2959,2925,3861,2043,3887,351,2865,369, + 1377,2639,1261,3625,3279,2201,2949,3049,449,1297,897,1891, + 411,2773,749,2753,1825,853,2775,3547,3923,3923,987,3723,2189, + 3877,3577,297,2763,1845,3083,2951,483,2169,3985,245,3655, + 3441,1023,235,835,3693,3585,327,1003,543,3059,2637/ DATA (VINIT(I,12),I=961,1111)/2923,87,3617,1031,1043,903,2913, + 2177,2641,3279,389,2009,525,4085,3299,987,2409,813,2683,373, + 2695,3775,2375,1119,2791,223,325,587,1379,2877,2867,3793,655, + 831,3425,1663,1681,2657,1865,3943,2977,1979,2271,3247,1267, + 1747,811,159,429,2001,1195,3065,553,1499,3529,1081,2877,3077, + 845,1793,2409,3995,2559,4081,1195,2955,1117,1409,785,287, + 1521,1607,85,3055,3123,2533,2329,3477,799,3683,3715,337,3139, + 3311,431,3511,2299,365,2941,3067,1331,1081,1097,2853,2299, + 495,1745,749,3819,619,1059,3559,183,3743,723,949,3501,733, + 2599,3983,3961,911,1899,985,2493,1795,653,157,433,2361,3093, + 3119,3679,2367,1701,1445,1321,2397,1241,3305,3985,2349,4067, + 3805,3073,2837,1567,3783,451,2441,1181,487,543,1201,3735, + 2517,733,1535,2175,3613,3019/ DATA (VINIT(I,13),I=482,680)/2319,653,1379,1675,1951,7075,2087, + 7147,1427,893,171,2019,7235,5697,3615,1961,7517,6849,2893, + 1883,2863,2173,4543,73,381,3893,6045,1643,7669,1027,1549, + 3983,1985,6589,7497,2745,2375,7047,1117,1171,1975,5199,3915, + 3695,8113,4303,3773,7705,6855,1675,2245,2817,1719,569,1021, + 2077,5945,1833,2631,4851,6371,833,7987,331,1899,8093,6719, + 6903,5903,5657,5007,2689,6637,2675,1645,1819,689,6709,7717, + 6295,7013,7695,3705,7069,2621,3631,6571,6259,7261,3397,7645, + 1115,4753,2047,7579,2271,5403,4911,7629,4225,1209,6955,6951, + 1829,5579,5231,1783,4285,7425,599,5785,3275,5643,2263,657, + 6769,6261,1251,3249,4447,4111,3991,1215,131,4397,3487,7585, + 5565,7199,3573,7105,7409,1671,949,3889,5971,3333,225,3647, + 5403,3409,7459,6879,5789,6567,5581,4919,1927,4407,8085,4691, + 611,3005,591,753,589,171,5729,5891,1033,3049,6567,5257,8003, + 1757,4489,4923,6379,5171,1757,689,3081,1389,4113,455,2761, + 847,7575,5829,633,6629,1103,7635,803,6175,6587,2711,3879,67, + 1179,4761,7281,1557,3379,2459,4273,4127,7147,35/ DATA (VINIT(I,13),I=681,877)/3549,395,3735,5787,4179,5889,5057, + 7473,4713,2133,2897,1841,2125,1029,1695,6523,1143,5105,7133, + 3351,2775,3971,4503,7589,5155,4305,1641,4717,2427,5617,1267, + 399,5831,4305,4241,3395,3045,4899,1713,171,411,7099,5473, + 5209,1195,1077,1309,2953,7343,4887,3229,6759,6721,6775,675, + 4039,2493,7511,3269,4199,6625,7943,2013,4145,667,513,2303, + 4591,7941,2741,987,8061,3161,5951,1431,831,5559,7405,1357, + 4319,4235,5421,2559,4415,2439,823,1725,6219,4903,6699,5451, + 349,7703,2927,7809,6179,1417,5987,3017,4983,3479,4525,4643, + 4911,227,5475,2287,5581,6817,1937,1421,4415,7977,1789,3907, + 6815,6789,6003,5609,4507,337,7427,7943,3075,6427,1019,7121, + 4763,81,3587,2929,1795,8067,2415,1265,4025,5599,4771,3025, + 2313,6129,7611,6881,5253,4413,7869,105,3173,1629,2537,1023, + 4409,7209,4413,7107,7469,33,1955,2881,5167,6451,4211,179, + 5573,7879,3387,7759,5455,7157,1891,5683,5689,6535,3109,6555, + 6873,1249,4251,6437,49,2745,1201,7327,4179,6783,623,2779, + 5963,2585,6927,5333,4033,285,7467,4443,4917,3/ DATA (VINIT(I,13),I=878,1070)/4319,5517,3449,813,5499,2515,5771, + 3357,2073,4395,4925,2643,7215,5817,1199,1597,1619,7535,4833, + 609,4797,8171,6847,793,6757,8165,3371,2431,5235,4739,7703, + 7223,6525,5891,5605,4433,3533,5267,5125,5037,225,6717,1121, + 5741,2013,4327,4839,569,5227,7677,4315,2391,5551,859,3627, + 6377,3903,4311,6527,7573,4905,7731,1909,1555,3279,1949,1887, + 6675,5509,2033,5473,3539,5033,5935,6095,4761,1771,1271,1717, + 4415,5083,6277,3147,7695,2461,4783,4539,5833,5583,651,1419, + 2605,5511,3913,5795,2333,2329,4431,3725,6069,2699,7055,6879, + 1017,3121,2547,4603,2385,6915,6103,5669,7833,2001,4287,6619, + 955,2761,5711,6291,3415,3909,2841,5627,4939,7671,6059,6275, + 6517,1931,4583,7301,1267,7509,1435,2169,6939,3515,2985,2787, + 2123,1969,3307,353,4359,7059,5273,5873,6657,6765,6229,3179, + 1583,6237,2155,371,273,7491,3309,6805,3015,6831,7819,713, + 4747,3935,4109,1311,709,3089,7059,4247,2989,1509,4919,1841, + 3045,3821,6929,4655,1333,6429,6649,2131,5265,1051,261,8057, + 3379,2179,1993,5655,3063,6381/ DATA (VINIT(I,13),I=1071,1111)/3587,7417,1579,1541,2107,5085,2873, + 6141,955,3537,2157,841,1999,1465,5171,5651,1535,7235,4349, + 1263,1453,1005,6893,2919,1947,1635,3963,397,969,4569,655, + 6737,2995,7235,7713,973,4821,2377,1673,1,6541/ DATA TAU/0,0,1,3,5,8,11,15,19,23,27,31,35/ C CHECK PARAMETERS: MAX = 30 ATMOST = 2**30-1 S = DIMEN IF (S.LE.MAXDEG) THEN TAUS = TAU(S) ELSE C RETURN A DUMMY VALUE TO THE CALLING PROGRAM TAUS = -1 END IF C FIND NUMBER OF BITS IN ATMOST: I = ATMOST MAXCOL = 0 10 MAXCOL = MAXCOL + 1 I = I/2 IF (I.GT.0) GOTO 10 C INITIALIZE ROW 1 OF V DO I = 1, MAXCOL V(1,I) = 1 ENDDO C INITIALIZE REMAINING ROWS OF V: DO I = 2, S C THE BIT PATTERN OF POLYNOMIAL I GIVES ITS FORM C FIND DEGREE OF POLYNOMIAL I FROM BINARY ENCODING J = POLY(I) M = 0 30 J = J/2 IF (J.GT.0) THEN M = M + 1 GOTO 30 ENDIF C WE EXPAND THIS BIT PATTERN TO SEPARATE COMPONENTS C OF THE LOGICAL ARRAY INCLUD. J = POLY(I) DO K = M, 1, -1 INCLUD(K) = (MOD(J, 2).EQ.1) J = J/2 ENDDO C THE LEADING ELEMENTS OF ROW I COME FROM VINIT DO J = 1, M V(I, J) = VINIT(I, J) ENDDO C CALCULATE REMAINING ELEMENTS OF ROW I AS EXPLAINED C IN BRATLEY AND FOX, SECTION 2 DO J = M + 1,MAXCOL NEWV = V(I, J-M) L = 1 DO K = 1, M L = 2*L IF (INCLUD(K)) NEWV = IEOR(NEWV, L*V(I, J-K)) C IF A FULL-WORD EXCLUSIVE-OR, SAY .IEOR., IS AVAILABLE, C THEN REPLACE THE PRECEDING STATEMENT BY ENDDO V(I, J) = NEWV ENDDO ENDDO C MULTIPLY COLUMNS OF V BY APPROPRIATE POWER OF 2: L = 1 DO J = MAXCOL-1, 1, -1 L = 2*L DO I = 1, S V(I, J) = V(I, J)*L ENDDO ENDDO C>>> SCRAMBLING START IF (scrambling .EQ. 0) THEN DO I = 1, S DO J = 1,MAXCOL SV(I, J) = V(I, J) ENDDO SHIFT(I) = 0 ENDDO LL= 2**MAXCOL ELSE IF ((scrambling .EQ. 1) .OR. (scrambling .EQ. 3)) THEN CALL SGENSCRML(MAX, LSM, SHIFT, S, MAXCOL, iSEED) DO I = 1,S DO J = 1,MAXCOL L = 1 TEMP2 = 0 DO P = MAX,1,-1 TEMP1 = 0 DO K = 1,MAXCOL TEMP01 = IBITS(LSM(I,P),K-1,1) * & IBITS(V(I,J),K-1,1) TEMP1 = TEMP1 + TEMP01 ENDDO TEMP1 = MOD(TEMP1, 2) TEMP2 = TEMP2+TEMP1*L L = 2 * L ENDDO SV(I, J) = TEMP2 ENDDO ENDDO LL= 2**MAX ENDIF IF ((scrambling .EQ. 2) .OR. (scrambling .EQ. 3)) THEN CALL SGENSCRMU(USM, USHIFT, S, MAXCOL, iSEED) IF (scrambling .EQ. 2) THEN MAXX = MAXCOL ELSE MAXX = MAX ENDIF DO I = 1, S DO J = 1, MAXCOL P = MAXX DO K = 1, MAXX IF (scrambling .EQ. 2) THEN TV(I,P,J) = IBITS(V(I,J),K-1,1) ELSE TV(I,P,J) = IBITS(SV(I,J),K-1,1) ENDIF P = P-1 ENDDO ENDDO DO PP = 1, MAXCOL TEMP2 = 0 TEMP4 = 0 L = 1 DO J = MAXX, 1, -1 TEMP1 = 0 TEMP3 = 0 DO P = 1, MAXCOL TEMP1 = TEMP1 + TV(I,J,P)*USM(P,PP) IF (PP .EQ. 1) THEN TEMP3 = TEMP3 + TV(I,J,P)*USHIFT(P) ENDIF ENDDO TEMP1 = MOD(TEMP1,2) TEMP2 = TEMP2 + TEMP1*L IF (PP .EQ. 1) THEN TEMP3 = MOD(TEMP3,2) TEMP4 = TEMP4 + TEMP3*L ENDIF L = 2*L ENDDO SV(I, PP) = TEMP2 IF (PP .EQ. 1) THEN IF (scrambling .EQ. 3) THEN SHIFT(I) = IEOR(TEMP4, SHIFT(I)) ELSE SHIFT(I) = TEMP4 ENDIF ENDIF ENDDO ENDDO LL = 2**MAXX ENDIF ENDIF C <<< END OF SCRAMBLING C RECIPD IS 1/(COMMON DENOMINATOR OF THE ELEMENTS IN SV) RECIPD = 1.0D0 / LL C SET UP FIRST VECTOR AND VALUES FOR "GOSOBL" COUNT = 0 DO I = 1, S QUASI(I) = SHIFT(I)*RECIPD ENDDO RETURN END C------------------------------------------------------------------------------- SUBROUTINE SGENSCRML(MAX, LSM, SHIFT, S, MAXCOL, iSEED) IMPLICIT NONE C GENERATING LOWER TRIANGULAR SCRAMBLING MATRICES AND SHIFT VECTORS. DOUBLE PRECISION UNIS INTEGER S,MAXCOL,P,I,J,MAX,TEMP,STEMP,L,LL INTEGER SHIFT(1111),LSM(1111,31) INTEGER iSEED DO P = 1, S SHIFT(P) = 0 L = 1 DO I = MAX, 1, -1 LSM(P, I) = 0 STEMP = MOD((INT(UNIS(iSEED)*1000.0D0)), 2) SHIFT(P) = SHIFT(P) + STEMP*L L = 2 * L LL = 1 DO J = MAXCOL, 1, -1 IF (J .EQ. I) THEN TEMP = 1 ELSEIF (J .LT. I) THEN TEMP = MOD((INT(UNIS(iSEED)*1000.0D0)), 2) ELSE TEMP = 0 ENDIF LSM(P ,I) = LSM(P, I) + TEMP*LL LL = 2 * LL ENDDO ENDDO ENDDO RETURN END C------------------------------------------------------------------------------- SUBROUTINE SGENSCRMU(USM, USHIFT, S, MAXCOL, iSEED) IMPLICIT NONE C GENERATING UPPER TRIANGULAR SCRAMBLING MATRICES AND SHIFT VECTORS. DOUBLE PRECISION UNIS INTEGER USM(31,31),MAXCOL,I,J INTEGER USHIFT(31),S,TEMP,STEMP INTEGER iSEED DO I = 1, MAXCOL STEMP = MOD((INT(UNIS(iSEED)*1000.0D0)), 2) USHIFT(I) = STEMP DO J = 1, MAXCOL IF (J .EQ. I) THEN TEMP = 1 ELSEIF (J .GT. I) THEN TEMP = MOD((INT(UNIS(iSEED)*1000.0D0)), 2) ELSE TEMP = 0 ENDIF USM(I, J) = TEMP ENDDO ENDDO RETURN END C------------------------------------------------------------------------------- DOUBLE PRECISION FUNCTION UNIS(IX) C PORTABLE PSEUDO-RANDOM NUMBER C GENERATOR IMPLEMENTING THE RECURSION C IX=16807*IX MOD(2**31-1) C UNIF=IX/(2**31-1) C USING ONLY 32 BITS INCLUDING SIGN C INPUT: C IX =INTEGER STRICTLY BETWEEN 0 AND 2** 31 -1 C OUTPUTS: C IX=NEW PSEUDO-RANDOM INTEGER C STRICTLY BETWEEN 0 AND 2**31-1 C UNIF=UNIFORM VARIATE (FRACTION) C STRICTLY BETWEEN 0 AND 1 C FOR JUSTIFICATION, SEE P. BRATLEY, C B.L. FOX, AND L.E. SCHRAGE (1983) C "A GUIDE TO SIMULATION" C SPRINGER-VERLAG, PAGES 201-202 IMPLICIT NONE INTEGER K1,IX K1 = IX/127773 IX = 16807*(IX-K1*127773)-K1*2836 IF (IX.LT.0) IX=IX+2147483647 UNIS = IX*4.656612875D-10 RETURN END C------------------------------------------------------------------------------- SUBROUTINE NEXTSOBOL(DIMEN, QUASI, LL, COUNT, SV) C GENERATES A NEW QUASI-RANDOM VECTOR WITH EACH CALL. IT ADAPTS THE C IDEAS OF ANTONOV AND SALEEV, USSR COMPUT. MATHS. MATH. PHYS. 19, C (1980), 252-256. "INITSOBOL" MUST BE CALLED BEFORE CALLING "NEXTSOBOL". C ARGUMENTS: C DIMEN - DIMENSION OF THE SEQUENCE C QUASI - LAST POINT IN THE SEQUENCE C LL - COMMON DENOMINATOR OF THE ELEMENTS IN SV C COUNT - SEQUENCE NUMBER OF THE CALL IMPLICIT NONE INTEGER DIMEN,MAXBIT,I,L,COUNT PARAMETER (MAXBIT=30) INTEGER SV(DIMEN,MAXBIT) DOUBLE PRECISION QUASI(DIMEN) INTRINSIC MOD, IEOR INTEGER LL L = 0 I = COUNT 10 L = L + 1 IF (MOD(I, 2).EQ.1) THEN I = I/2 GOTO 10 END IF C CALCULATE THE NEW COMPONENTS OF QUASI, C FIRST THE NUMERATORS, THEN NORMALIZED DO I = 1, DIMEN QUASI(I) = REAL(IEOR(INT(QUASI(I)*LL), SV(I, L)))/LL ENDDO COUNT = COUNT + 1 RETURN END C------------------------------------------------------------------------------- c$$$ c$$$ SUBROUTINE TESTSOBOL() c$$$ c$$$ IMPLICIT NONE c$$$ c$$$C TESTROUTINE, CALLED FROM THE FORTRAN MAIN PROGRAM c$$$ INTEGER MAXBIT,DIMEN,TRANSFORM c$$$ INTEGER N1, N2 c$$$ PARAMETER (N1=20,N2=N1/2,DIMEN=5,MAXBIT=30) c$$$ INTEGER LL,COUNT,SV(DIMEN,MAXBIT) c$$$ DOUBLE PRECISION QN1(N1,DIMEN),QN2(N2,DIMEN),QUASI(DIMEN) c$$$ INTEGER iSEED, iSEED1 c$$$ INTEGER I, INIT, scrambling, J c$$$ c$$$ TRANSFORM = 1 c$$$ scrambling = 3 c$$$ iSEED1 = 4711 c$$$ c$$$ INIT = 1 c$$$ iSEED = iSEED1 c$$$ CALL SOBOL(QN1, N1, DIMEN, QUASI ,LL, COUNT, SV, c$$$ & scrambling, iSEED, INIT, TRANSFORM) c$$$ c$$$ WRITE (*,*) c$$$ WRITE (*,7) "N/DIMEN:", (J, J=1,DIMEN,INT(DIMEN/5)) c$$$ DO I=1, N1, INT(N1/(2*10)) c$$$ WRITE (*,8) I, (QN1(I,J), J=1, DIMEN, INT(DIMEN/5)) c$$$ ENDDO c$$$ c$$$ INIT=1 c$$$ iSEED = iSEED1 c$$$ CALL SOBOL(QN2, N2, DIMEN, QUASI, LL, COUNT, SV, c$$$ & scrambling, iSEED, INIT, TRANSFORM) c$$$ WRITE (*,*) c$$$ WRITE (*,7) "N/DIMEN:", (J, J=1,DIMEN,INT(DIMEN/5)) c$$$ DO I=1, N2, INT(N2/10) c$$$ WRITE (*,8) I, (QN2(I,J), J=1, DIMEN, INT(DIMEN/5)) c$$$ ENDDO c$$$ c$$$ INIT = 0 c$$$ CALL SOBOL(QN2, N2, DIMEN, QUASI, LL, COUNT, SV, c$$$ & scrambling, iSEED, INIT, TRANSFORM) c$$$ WRITE (*,*) c$$$ WRITE (*,7) "N/DIMEN:", (J, J=1,DIMEN,INT(DIMEN/5)) c$$$ DO I=1, N2, INT(N2/10) c$$$ WRITE (*,8) I+N2, (QN2(I,J), J=1, DIMEN, INT(DIMEN/5)) c$$$ ENDDO c$$$ c$$$ 7 FORMAT(1H ,A8, 10I10) c$$$ 8 FORMAT(1H ,I8, 10F10.6) c$$$ c$$$ RETURN c$$$ END C------------------------------------------------------------------------------- C program mainsobol C call testsobol() C end C------------------------------------------------------------------------------- fOptions/NAMESPACE0000644000175100001440000000174012620131167013311 0ustar hornikusers################################################################################ ## Exports ################################################################################ exportPattern(".") # In the future this should be used: #exportPattern("^[^\\.]") S3method("print", "hngarch") S3method("print", "option") S3method("summary", "fOPTION") S3method("summary", "hngarch") S3method("summary", "option") ################################################################################ ## Imports ################################################################################ import("timeDate") import("timeSeries") import("fBasics") importFrom("graphics", "text") importFrom("methods", "new") importFrom("stats", "dnorm", "integrate", "nlm", "rnorm", "runif", "uniroot", "var") ################################################################################ ## Libraries ################################################################################ useDynLib("fOptions") fOptions/R/0000755000175100001440000000000012620131167012271 5ustar hornikusersfOptions/R/BasicAmericanOptions.R0000644000175100001440000002712312620131167016456 0ustar hornikusers # 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: # RollGeskeWhaleyOption Roll-Geske-Whaley Calls on Dividend Paying Stocks # BAWAmericanApproxOption Barone-Adesi and Whaley Approximation # BSAmericanApproxOption Bjerksund and Stensland Approximation ################################################################################ RollGeskeWhaleyOption = function(S, X, time1, Time2, r, D, sigma, title = NULL, description = NULL) { # A function implemented by Diethelm Wuertz # Description: # Calculates the option price of an American call on a stock # paying a single dividend with specified time to divident # payout. The option valuation formula derived by Roll, Geske # and Whaley is used. # References: # Haug E.G., The Complete Guide to Option Pricing Formulas # FUNCTION: # Settings: big = 100000000 eps = 1.0e-5 t1 = time1 T2 = Time2 # Compute: Sx = S - D * exp(-r * t1) if(D <= X * (1 - exp(-r*(T2-t1)))) { result = GBSOption("c", Sx, X, T2, r, b=r, sigma)@price cat("\nWarning: Not optimal to exercise\n") return(result) } ci = GBSOption("c", S, X, T2-t1, r, b=r, sigma)@price HighS = S while ( ci-HighS-D+X > 0 && HighS < big ) { HighS = HighS * 2 ci = GBSOption("c", HighS, X, T2-t1, r, b=r, sigma)@price } if(HighS > big) { result = GBSOption("c", Sx, X, T2, r, b=r, sigma)@price stop()} LowS = 0 I = HighS * 0.5 ci = GBSOption("c", I, X, T2-t1, r, b=r, sigma)@price # Search algorithm to find the critical stock price I while ( abs(ci-I-D+X) > eps && HighS - LowS > eps ) { if(ci-I-D+X < 0 ) { HighS = I } else { LowS = I } I = (HighS + LowS) / 2 ci = GBSOption("c", I, X, T2-t1, r, b=r, sigma)@price } a1 = (log(Sx/X) + (r+sigma^2/2)*T2) / (sigma*sqrt(T2)) a2 = a1 - sigma*sqrt(T2) b1 = (log(Sx/I) + (r+sigma^2/2)*t1) / (sigma*sqrt(t1)) b2 = b1 - sigma*sqrt(t1) result = Sx*CND(b1) + Sx*CBND(a1,-b1,-sqrt(t1/T2)) - X*exp(-r*T2)*CBND(a2,-b2,-sqrt(t1/T2)) - (X-D)*exp(-r*t1)*CND(b2) # Parameters: # S, X, time1, Time2, r, D, sigma param = list() param$S = S param$X = X param$time1 = time1 param$Time2 = Time2 param$r = r param$D = D param$sigma = sigma # Add title and description: if(is.null(title)) title = "Roll Geske Whaley Option" if(is.null(description)) description = as.character(date()) # Return Value: new("fOPTION", call = match.call(), parameters = param, price = result, title = title, description = description ) } # ****************************************************************************** BAWAmericanApproxOption = function(TypeFlag = c("c", "p"), S, X, Time, r, b, sigma, title = NULL, description = NULL) { # A function implemented by Diethelm Wuertz # Description: # Calculates the option price of an American call or put # option on an underlying asset for a given cost-of-carry rate. # The quadratic approximation method by Barone-Adesi and # Whaley is used. # References: # Haug E.G., The Complete Guide to Option Pricing Formulas # FUNCTION: # Settings: TypeFlag = TypeFlag[1] # Compute: if(TypeFlag == "c") { result = .BAWAmCallApproxOption(S, X, Time, r, b, sigma) } if(TypeFlag == "p") { result = .BAWAmPutApproxOption(S, X, Time, r, b, sigma) } # 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 = "BAW American Approximated Option" if(is.null(description)) description = as.character(date()) # Return Value: new("fOPTION", call = match.call(), parameters = param, price = result, title = title, description = description ) } .BAWAmCallApproxOption <- function(S, X, Time, r, b, sigma) { # Internal Function - The Call: # Compute: if(b >= r) { result = GBSOption("c", S, X, Time, r, b, sigma)@price } else { Sk = .bawKc(X, Time, r, b, sigma) n = 2*b/sigma^2 K = 2*r/(sigma^2*(1-exp(-r*Time))) d1 = (log(Sk/X)+(b+sigma^2/2)*Time)/(sigma*sqrt(Time)) Q2 = (-(n-1)+sqrt((n-1)^2+4*K))/2 a2 = (Sk/Q2)*(1-exp((b-r)*Time)*CND(d1)) if(S < Sk) { result = GBSOption("c", S, X, Time, r, b, sigma)@price + a2*(S/Sk)^Q2 } else { result = S-X } } # Return Value: result } .bawKc <- function(X, Time, r, b, sigma) { # Newton Raphson algorithm to solve for the critical commodity # price for a Call. # Calculation of seed value, Si n = 2*b/sigma^2 m = 2*r/sigma^2 q2u = (-(n-1)+sqrt((n-1)^2+4*m))/2 Su = X/(1-1/q2u) h2 = -(b*Time+2*sigma*sqrt(Time))*X/(Su-X) Si = X+(Su-X)*(1-exp(h2)) K = 2*r/(sigma^2*(1-exp(-r*Time))) d1 = (log(Si/X)+(b+sigma^2/2)*Time)/(sigma*sqrt(Time)) Q2 = (-(n-1)+sqrt((n-1)^2+4*K))/2 LHS = Si-X RHS = GBSOption("c", Si, X, Time, r, b, sigma)@price + (1-exp((b-r)*Time)*CND(d1))*Si/Q2 bi = exp((b-r)*Time)*CND(d1)*(1-1/Q2) + (1-exp((b-r)*Time)*CND(d1)/(sigma*sqrt(Time)))/Q2 E = 0.000001 # Newton Raphson algorithm for finding critical price Si while (abs(LHS-RHS)/X > E) { Si = (X+RHS-bi*Si)/(1-bi) d1 = (log(Si/X)+(b+sigma^2/2)*Time)/(sigma*sqrt(Time)) LHS = Si-X RHS = GBSOption("c", Si, X, Time, r, b, sigma)@price + (1-exp((b-r)*Time)*CND(d1))*Si/Q2 bi = exp((b-r)*Time)*CND(d1)*(1-1/Q2) + ( 1-exp((b-r)*Time)*CND(d1)/(sigma*sqrt(Time)))/Q2 } # Return Value: Si } .BAWAmPutApproxOption <- function(S, X, Time, r, b, sigma) { # Internal Function - The Put: # Compute: Sk = .bawKp(X, Time, r, b, sigma) n = 2*b/sigma^2 K = 2*r/(sigma^2*(1-exp(-r*Time))) d1 = (log(Sk/X)+(b+sigma^2/2)*Time)/(sigma*sqrt(Time)) Q1 = (-(n-1)-sqrt((n-1)^2+4*K))/2 a1 = -(Sk/Q1)*(1-exp((b-r)*Time)*CND(-d1)) if(S > Sk) { result = GBSOption("p", S, X, Time, r, b, sigma)@price + a1*(S/Sk)^Q1 } else { result = X-S } # Return Value: result } .bawKp <- function(X, Time, r, b, sigma) { # Internal Function - used for the Put: # Newton Raphson algorithm to solve for the critical commodity # price for a Put. # Calculation of seed value, Si n = 2*b/sigma^2 m = 2*r/sigma^2 q1u = (-(n-1)-sqrt((n-1)^2+4*m))/2 Su = X/(1-1/q1u) h1 = (b*Time-2*sigma*sqrt(Time))*X/(X-Su) Si = Su+(X-Su)*exp(h1) K = 2*r/(sigma^2*(1-exp(-r*Time))) d1 = (log(Si/X)+(b+sigma^2/2)*Time)/(sigma*sqrt(Time)) Q1 = (-(n-1)-sqrt((n-1)^2+4*K))/2 LHS = X-Si RHS = GBSOption("p", Si, X, Time, r, b, sigma)@price - (1-exp((b-r)*Time)*CND(-d1))*Si/Q1 bi = -exp((b-r)*Time)*CND(-d1)*(1-1/Q1) - (1+exp((b-r)*Time)*CND(-d1)/(sigma*sqrt(Time)))/Q1 E = 0.000001 # Newton Raphson algorithm for finding critical price Si while (abs(LHS-RHS)/X > E ) { Si = (X-RHS+bi*Si)/(1+bi) d1 = (log(Si/X)+(b+sigma^2/2)*Time)/(sigma*sqrt(Time)) LHS = X-Si RHS = GBSOption("p", Si, X, Time, r, b, sigma)@price - (1-exp((b-r)*Time)*CND(-d1))*Si/Q1 bi = -exp((b-r)*Time)*CND(-d1)*(1-1/Q1) - (1+exp((b-r)*Time)*CND(-d1)/(sigma*sqrt(Time)))/Q1 } # Return Value: Si } # ------------------------------------------------------------------------------ BSAmericanApproxOption = function(TypeFlag = c("c", "p"), S, X, Time, r, b, sigma, title = NULL, description = NULL) { # A function implemented by Diethelm Wuertz # Description: # Calculates the option price of an American call or # put option stocks, futures, and currencies. The # approximation method by Bjerksund and Stensland is used. # References: # Haug E.G., The Complete Guide to Option Pricing Formulas # FUNCTION: # Settings: TypeFlag = TypeFlag[1] # The Bjerksund and Stensland (1993) American approximation: if(TypeFlag == "c") { result = .BSAmericanCallApprox(S, X, Time, r, b, sigma) } if(TypeFlag == "p") { # Use the Bjerksund and Stensland put-call transformation result = .BSAmericanCallApprox(X, S, Time, r - b, -b, sigma) } # 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 if(!is.na(result$TriggerPrice)) param$TrigerPrice = result$TriggerPrice # Add title and description: if(is.null(title)) title = "BS American Approximated Option" if(is.null(description)) description = as.character(date()) # Return Value: new("fOPTION", call = match.call(), parameters = param, price = result$Premium, title = title, description = description ) } .BSAmericanCallApprox <- function(S, X, Time, r, b, sigma) { # Call Approximation: if(b >= r) { # Never optimal to exersice before maturity result = list( Premium = GBSOption("c", S, X, Time, r, b, sigma)@price, TriggerPrice = NA) } else { Beta = (1/2 - b/sigma^2) + sqrt((b/sigma^2 - 1/2)^2 + 2*r/sigma^2) BInfinity = Beta/(Beta-1) * X B0 = max(X, r/(r-b) * X) ht = -(b*Time + 2*sigma*sqrt(Time)) * B0/(BInfinity-B0) # Trigger Price I: I = B0 + (BInfinity-B0) * (1 - exp(ht)) alpha = (I-X) * I^(-Beta) if(S >= I) { result = list( Premium = S-X, TriggerPrice = I) } else { result = list( Premium = alpha*S^Beta - alpha*.bsPhi(S,Time,Beta,I,I,r,b,sigma) + .bsPhi(S,Time,1,I,I,r,b,sigma) - .bsPhi(S,Time,1,X,I,r,b,sigma) - X*.bsPhi(S,Time,0,I,I,r,b,sigma) + X*.bsPhi(S,Time,0,X,I,r,b,sigma), TriggerPrice = I) } } result} .bsPhi <- function(S, Time, gamma, H, I, r, b, sigma) { # Utility function phi: lambda = (-r + gamma*b + 0.5*gamma * (gamma-1)*sigma^2) * Time d = -(log(S/H) + (b + (gamma-0.5)*sigma^2)*Time) / (sigma*sqrt(Time)) kappa = 2 * b / (sigma^2) + (2*gamma - 1) result = exp(lambda)*S^gamma * (CND(d)-(I/S)^kappa*CND(d-2*log(I/S)/(sigma*sqrt(Time)))) # Return Value: result } ################################################################################ fOptions/R/LowDiscrepancy.R0000644000175100001440000001705212620131167015347 0ustar hornikusers # 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: # runif.pseudo Uniform Pseudo Random number sequence # rnorm.pseudo Normal Pseudo Random number sequence # runif.halton Uniform Halton low discrepancy sequence # rnorm.halton Normal Halton low discrepancy sequence # runif.sobol Uniform Sobol low discrepancy sequence # rnorm.sobol Normal Sobol low discrepancy sequence ################################################################################ runif.pseudo <- function(n, dimension, init = NULL) { # Description: # Uniform Pseudo Random number sequence matrix(runif(n*dimension), ncol = dimension) } # ------------------------------------------------------------------------------ rnorm.pseudo <- function(n, dimension, init = TRUE) { # Description: # Normal Pseudo Random number sequence matrix(rnorm(n*dimension), ncol = dimension) } # ----------------------------------------------------------------------------- runif.halton <- function (n, dimension, init = TRUE) { # A function implemented by Diethelm Wuertz # Description: # Uniform Halton Low Discrepancy Sequence # Details: # DIMENSION : dimension <= 200 # N : LD numbers to create # FUNCTION: # Restart Settings: if (init) { ## YC : this code should not needed since we have now global Env # .warn = options()$warn # options(warn = -1) # rm(".runif.halton.seed") # options(warn = .warn) .setfOptionsEnv(.runif.halton.seed = list(base = rep(0, dimension), offset = 0)) } optEnv <- .getfOptionsEnv(".runif.halton.seed") # SUBROUTINE HALTON(QN, N, DIMEN, BASE, OFFSET, INIT, TRANSFORM) result <- .Fortran("halton", qn = numeric(n*dimension), as.integer(n), as.integer(dimension), base = as.integer(optEnv$base), offset=as.integer(optEnv$offset), as.integer(init), 0L, PACKAGE = "fOptions") # For the next numbers save: .setfOptionsEnv(.runif.halton.seed = result[c("base", "offset")]) matrix(result[["qn"]], ncol = dimension) } # ------------------------------------------------------------------------------ rnorm.halton <- function (n, dimension, init = TRUE) { # A function implemented by Diethelm Wuertz # Description: # Normal Halton Low Discrepancy Sequence # Details: # DIMENSION : dimension <= 200 # N : LD numbers to create # FUNCTION: # Restart Settings: if (init) { ### .warn = options()$warn ### options(warn = -1) ### rm(".rnorm.halton.seed") ### options(warn = .warn) .setfOptionsEnv(.rnorm.halton.seed = list(base = rep(0, dimension), offset = 0)) } optEnv <- .getfOptionsEnv(".rnorm.halton.seed") # SUBROUTINE HALTON(QN, N, DIMEN, BASE, OFFSET, INIT, TRANSFORM) result <- .Fortran("halton", qn = numeric(n * dimension), as.integer(n), as.integer(dimension), base = as.integer(optEnv$base), offset=as.integer(optEnv$offset), as.integer(init), 1L, PACKAGE = "fOptions") # For the next numbers save: .setfOptionsEnv(.rnorm.halton.seed = result[c("base", "offset")]) matrix(result[["qn"]], ncol = dimension) } # ----------------------------------------------------------------------------- runif.sobol <- function (n, dimension, init = TRUE, scrambling = 0, seed = 4711) { # A function implemented by Diethelm Wuertz # Description: # Uniform Sobol Low Discrepancy Sequence # Details: # DIMENSION : dimension <= 200 # N : LD numbers to create # SCRAMBLING : One of the numbers 0,1,2,3 # # FUNCTION: stopifnot(0 <= (scrambling <- as.integer(scrambling)), scrambling <= 3) # Restart Settings: if (init) { .setfOptionsEnv(.runif.sobol.seed = list(quasi = rep(0, dimension), ll = 0, count = 0, sv = rep(0, dimension*30), seed = seed)) } optEnv <- .getfOptionsEnv(".runif.sobol.seed") # SSOBOL(QN,N,DIMEN,QUASI,LL,COUNT,SV,scrambling,SEED,INIT,TRANSFORM) result <- .Fortran("sobol", qn = numeric(n * dimension), as.integer(n), as.integer(dimension), quasi = as.double (optEnv$quasi), ll = as.integer(optEnv$ll), count = as.integer(optEnv$count), sv = as.integer(optEnv$sv), scrambling, seed = as.integer(optEnv$seed), as.integer(init), 0L, PACKAGE = "fOptions") # For the next numbers save: .setfOptionsEnv(.runif.sobol.seed = result[c("quasi","ll","count","sv","seed")]) matrix(result[["qn"]], ncol = dimension) } # ------------------------------------------------------------------------------ rnorm.sobol <- function (n, dimension, init = TRUE, scrambling = 0, seed = 4711) { # A function implemented by Diethelm Wuertz # Description: # Normal Sobol Low Discrepancy Sequence # Details: # DIMENSION : dimension <= 200 # N : LD numbers to create # SCRAMBLING : One of the numbers 0,1,2,3 # FUNCTION: stopifnot(0 <= (scrambling <- as.integer(scrambling)), scrambling <= 3) # Restart Settings: if (init) { .setfOptionsEnv(.rnorm.sobol.seed = list( quasi = rep(0, dimension), ll = 0, count = 0, sv = rep(0, dimension*30), seed = seed)) } optEnv <- .getfOptionsEnv(".rnorm.sobol.seed") # SSOBOL(QN,N,DIMEN,QUASI,LL,COUNT,SV,scrambling,SEED,INIT,TRANSFORM) result <- .Fortran("sobol", qn = numeric(n * dimension), as.integer(n), as.integer(dimension), quasi = as.double (optEnv$quasi), ll = as.integer(optEnv$ll), count = as.integer(optEnv$count), sv = as.integer(optEnv$sv), scrambling, seed = as.integer(optEnv$seed), as.integer(init), 1L, PACKAGE = "fOptions") # For the next numbers save: .setfOptionsEnv(.rnorm.sobol.seed = result[c("quasi","ll","count","sv","seed")]) matrix(result[["qn"]], ncol = dimension) } ################################################################################ fOptions/R/MonteCarloOptions.R0000644000175100001440000000774612620131167016051 0ustar hornikusers # 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: # MonteCarloOption Valuate Options by Monte Carlo Simulation ################################################################################ MonteCarloOption = function(delta.t, pathLength, mcSteps, mcLoops, init = TRUE, innovations.gen, path.gen, payoff.calc, antithetic = TRUE, standardization = FALSE, trace = TRUE, ...) { # A function implemented by Diethelm Wuertz # Description: # Valuates Options by Monte Carlo Simulation # Arguments: # delta.t - The length of the time interval, by default one day. # pathLength - Number of Time Intervals which add up to the path. # mcSteps - The number of Monte Carlo Steps performed in one loop. # mcLoops - The number of Monte Carlo Loops # init - Should the random number generator be initialized ? # This variable must appear in the argument list of the # random number generator, even it will not ne used # innovations.gen # - the generator function for the innovations # path.gen - the generator for the MC paths # payoff.calc # - the payoff claculator function # antithetic - if TRUE, antithetic paths are used in the MC simulation # standardization # - if TRUE, the random numbers will be standardized so that # their mean is zero and their variance is zero # trace - a logical, should the iteration path be traced ? # ... - additional parameters passed to innovations.gen. # Notes: # Global Variables: # The options parameter must be globally available. # For a Black-Scholes or a simple Asian Option these are: # TypeFlag, S, X, Time, r, b, sigma # Required Functions: # The user must specify the following functions: # innovations.gen() # path.gen() # payoff.calc() # FUNCTION # Monte Carlo Simulation: delta.t <<- delta.t if (trace) cat("\nMonte Carlo Simulation Path:\n\n") iteration = rep(0, length = mcLoops) # MC Iteration Loop: cat("\nLoop:\t", "No\t") for ( i in 1:mcLoops ) { if ( i > 1) init = FALSE # Generate Innovations: eps = innovations.gen(mcSteps, pathLength, init = init, ...) # Use Antithetic Variates if requested: if (antithetic) eps = rbind(eps, -eps) # Standardize Variates if requested: if (standardization) eps = (eps-mean(eps))/sqrt(var(as.vector(eps))) # Calculate for each path the option price: path = t(path.gen(eps)) payoff = NULL for (j in 1:dim(path)[1]) payoff = c(payoff, payoff.calc(path[, j])) iteration[i] = mean(payoff) # Trace the Simualtion if desired: if (trace) cat("\nLoop:\t", i, "\t:", iteration[i], sum(iteration)/i ) } if (trace) cat("\n") # Return Value: iteration } # ****************************************************************************** fOptions/R/BinomialTreeOptions.R0000644000175100001440000003201412620131167016342 0ustar hornikusers # 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: # CRRBinomialTreeOption Cox-Ross-Rubinstein Binomial Tree Option Model # JRBinomialTreeOption JR Modfication to the Binomial Tree Option # TIANBinomialTreeOption Tian's Modification to the Binomial Tree Option # FUNCTION: # BinomialTreeOption CRR Binomial Tree Option with Cost of Carry Term # BinomialTreePlot Plots results from the CRR Option Pricing Model ############################################################################### CRRBinomialTreeOption = function(TypeFlag = c("ce", "pe", "ca", "pa"), S, X, Time, r, b, sigma, n, title = NULL, description = NULL) { # A function implemented by Diethelm Wuertz # Description: # Cox-Ross-Rubinstein Binomial Tree Option Model # FUNCTION: # Check Flags: TypeFlag = TypeFlag[1] z = NA if (TypeFlag == "ce" || TypeFlag == "ca") z = +1 if (TypeFlag == "pe" || TypeFlag == "pa") z = -1 if (is.na(z)) stop("TypeFlag misspecified: ce|ca|pe|pa") # Parameters: dt = Time/n u = exp(sigma*sqrt(dt)) d = 1/u p = (exp(b*dt)-d)/(u-d) Df = exp(-r*dt) # Iteration: OptionValue = z*(S*u^(0:n)*d^(n:0) - X) OptionValue = (abs(OptionValue) + OptionValue) / 2 # European Option: if (TypeFlag == "ce" || TypeFlag == "pe") { for ( j in seq(from = n-1, to = 0, by = -1) ) for ( i in 0:j ) OptionValue[i+1] = (p*OptionValue[i+2] + (1-p)*OptionValue[i+1]) * Df } # American Option: if (TypeFlag == "ca" || TypeFlag == "pa") { for ( j in seq(from = n-1, to = 0, by = -1) ) for ( i in 0:j ) OptionValue[i+1] = max((z * (S*u^i*d^(abs(i-j)) - X)), (p*OptionValue[i+2] + (1-p)*OptionValue[i+1]) * Df) } # Return Value: # Parameters: # TypeFlag = c("ce", "pe", "ca", "pa"), S, X, Time, r, b, sigma, n param = list() param$TypeFlag = TypeFlag param$S = S param$X = X param$Time = Time param$r = r param$b = b param$sigma = sigma param$n = n # Add title and description: if (is.null(title)) title = "CRR Binomial Tree Option" if (is.null(description)) description = as.character(date()) # Return Value: new("fOPTION", call = match.call(), parameters = param, price = OptionValue[1], title = title, description = description ) } # ------------------------------------------------------------------------------ JRBinomialTreeOption = function(TypeFlag = c("ce", "pe", "ca", "pa"), S, X, Time, r, b, sigma, n, title = NULL, description = NULL) { # A function implemented by Diethelm Wuertz # Description: # JR Modfication to the Binomial Tree Option # FUNCTION: # Check Flags: TypeFlag = TypeFlag[1] if (TypeFlag == "ce" || TypeFlag == "ca") z = +1 if (TypeFlag == "pe" || TypeFlag == "pa") z = -1 # Parameters: dt = Time/n # DW Bug Fix: r -> b u = exp( (b-sigma^2/2)*dt+sigma*sqrt(dt) ) d = exp( (b-sigma^2/2)*dt-sigma*sqrt(dt) ) # DW End of Bug Fix p = 1/2 Df = exp(-r*dt) # Iteration: OptionValue = z*(S*u^(0:n)*d^(n:0) - X) OptionValue = (abs(OptionValue) + OptionValue) / 2 # European Option: if (TypeFlag == "ce" || TypeFlag == "pe") { for ( j in seq(from = n-1, to = 0, by = -1) ) for ( i in 0:j ) OptionValue[i+1] = (p*OptionValue[i+2] + (1-p)*OptionValue[i+1]) * Df } # American Option: if (TypeFlag == "ca" || TypeFlag == "pa") { for ( j in seq(from = n-1, to=0, by = -1) ) for ( i in 0:j ) OptionValue[i+1] = max((z * (S*u^i*d^(abs(i-j)) - X)), (p*OptionValue[i+2] + (1-p)*OptionValue[i+1]) * Df) } # Return Value: OptionValue[1] # Parameters: # TypeFlag = c("ce", "pe", "ca", "pa"), S, X, Time, r, b, sigma, n param = list() param$TypeFlag = TypeFlag param$S = S param$X = X param$Time = Time param$r = r param$b = b param$sigma = sigma param$n = n # Add title and description: if (is.null(title)) title = "JR Binomial Tree Option" if (is.null(description)) description = as.character(date()) # Return Value: new("fOPTION", call = match.call(), parameters = param, price = OptionValue[1], title = title, description = description ) } # ------------------------------------------------------------------------------ TIANBinomialTreeOption = function(TypeFlag = c("ce", "pe", "ca", "pa"), S, X, Time, r, b, sigma, n, title = NULL, description = NULL) { # A function implemented by Diethelm Wuertz # Description: # Tian's Modification to the Binomial Tree Option # FUNCTION: # Check Flags: TypeFlag = TypeFlag[1] if (TypeFlag == "ce" || TypeFlag == "ca") z = +1 if (TypeFlag == "pe" || TypeFlag == "pa") z = -1 # Parameters: dt = Time/n M = exp ( b*dt ) V = exp ( sigma^2 * dt ) u = (M*V/2) * ( V + 1 + sqrt(V*V + 2*V - 3) ) d = (M*V/2) * ( V + 1 - sqrt(V*V + 2*V - 3) ) p = (M-d)/(u-d) Df = exp(-r*dt) # Iteration: OptionValue = z*(S*u^(0:n)*d^(n:0) - X) OptionValue = (abs(OptionValue) + OptionValue) / 2 # European Option: if (TypeFlag == "ce" || TypeFlag == "pe") { for ( j in seq(from = n-1, to = 0, by = -1) ) for ( i in 0:j ) OptionValue[i+1] = (p*OptionValue[i+2] + (1-p)*OptionValue[i+1]) * Df } # American Option: if (TypeFlag == "ca" || TypeFlag == "pa") { for ( j in seq(from = n-1, to = 0, by = -1) ) for ( i in 0:j ) OptionValue[i+1] = max((z * (S*u^i*d^(abs(i-j)) - X)), (p*OptionValue[i+2] + (1-p)*OptionValue[i+1]) * Df) } # Return Value: OptionValue[1] # Parameters: # TypeFlag = c("ce", "pe", "ca", "pa"), S, X, Time, r, b, sigma, n param = list() param$TypeFlag = TypeFlag param$S = S param$X = X param$Time = Time param$r = r param$b = b param$sigma = sigma param$n = n # Add title and description: if (is.null(title)) title = "TIAN Binomial Tree Option" if (is.null(description)) description = as.character(date()) # Return Value: new("fOPTION", call = match.call(), parameters = param, price = OptionValue[1], title = title, description = description ) } # ****************************************************************************** BinomialTreeOption = function(TypeFlag = c("ce", "pe", "ca", "pa"), S, X, Time, r, b, sigma, n, title = NULL, description = NULL) { # A function implemented by Diethelm Wuertz # Description: # Calculates option prices from the Cox-Ross-Rubinstein # Binomial tree model. # Note: # The model described here is a version of the CRR Binomial # Tree model. Including a cost of carry term b, the model can # used to price European and American Options on # b=r stocks # b=r-q stocks and stock indexes paying a continuous # dividend yield q # b=0 futures # b=r-rf currency options with foreign interst rate rf # Example: # par(mfrow=c(1,1)) # Tree = BinomialTree("pa", 100, 95, 0.5, 0.08, 0.08, 0.3, 5) # print(round(Tree, digits=3)) # BinomialTreePlot(Tree, main="American Put Option") # # Reference: # E.G. Haug, The Complete Guide to Option Pricing Formulas, # 1997, Chapter 3.1.1 # FUNCTION: # Check Flags: TypeFlag = TypeFlag[1] if (TypeFlag == "ce" || TypeFlag == "ca") z = +1 if (TypeFlag == "pe" || TypeFlag == "pa") z = -1 # Parameters: dt = Time / n u = exp(sigma*sqrt(dt)) d = 1 / u p = (exp(b*dt) - d) / (u - d) Df = exp(-r*dt) # Algorithm: OptionValue = z*(S*u^(0:n)*d^(n:0) - X) offset = 1 Tree = OptionValue = (abs(OptionValue)+OptionValue)/2 # European Type: if (TypeFlag == "ce" || TypeFlag == "pe") { for (j in (n-1):0) { Tree <-c(Tree, rep(0, times=n-j)) for (i in 0:j) { OptionValue[i+offset] = (p*OptionValue[i+1+offset] + (1-p)*OptionValue[i+offset]) * Df Tree = c(Tree, OptionValue[i+offset]) } } } # American Type: if (TypeFlag == "ca" || TypeFlag == "pa") { for (j in (n-1):0) { Tree <-c(Tree, rep(0, times=n-j)) for (i in 0:j) { OptionValue[i+offset] = max((z * (S*u^i*d^(abs(i-j)) - X)), (p*OptionValue[i+1+offset] + (1-p)*OptionValue[i+offset]) * Df ) Tree = c(Tree, OptionValue[i+offset]) } } } # Tree-Matrix of form (here n=4): # x x x x # . x x x # . . x x # . . . x Tree = matrix(rev(Tree), byrow = FALSE, ncol = n+1) # Tree Output: # if (doprint) print(Tree) # Parameters: # TypeFlag = c("ce", "pe", "ca", "pa"), S, X, Time, r, b, sigma, n # param = list() # param$TypeFlag = TypeFlag # param$S = S # param$X = X # param$Time = Time # param$r = r # param$b = b # param$sigma = sigma # param$n = n # Add title and description: # if (is.null(title)) title = "Binomial Tree Option" # if (is.null(description)) description = as.character(date()) # Return Value: # new("fOPTION", # call = match.call(), # parameters = param, # price = Tree[1], # title = title, # description = description # ) # Return Value: invisible(Tree) } # ------------------------------------------------------------------------------ BinomialTreePlot = function(BinomialTreeValues, dx = -0.025, dy = 0.4, cex = 1, digits = 2, ...) { # A function implemented by Diethelm Wuertz # Description: # Plots the binomial tree of the Cox-Ross-Rubinstein # binomial tree model. # Example: # par(mfrow=c(1,1)) # Tree = BinomialTree("a", "p", 100, 95, 0.5, 0.08, 0.08, 0.3, 5) # print(round(Tree, digits = 3)) # BinomialTreePlot(Tree, main = "American Put Option") # FUNCTION: # Tree: Tree = round(BinomialTreeValues, digits = digits) depth = ncol(Tree) plot(x = c(1,depth), y = c(-depth+1, depth-1), type = "n", col = 0, ...) points(x = 1, y = 0) text(1+dx, 0+dy, deparse(Tree[1, 1]), cex = cex) for (i in 1:(depth-1) ) { y = seq(from = -i, by = 2, length = i+1) x = rep(i, times = length(y))+1 points(x, y, col = 1) for (j in 1:length(x)) text(x[j]+dx, y[j]+dy, deparse(Tree[length(x)+1-j,i+1]), cex = cex) y = (-i):i x = rep(c(i+1,i), times = 2*i)[1:length(y)] lines(x, y, col = 2) } # Return Value: invisible() } # --- 3.1.2 -------------------------------------------------------------------- # Options on a Stock Paying a Known Dividend Yield # not yet implemented # --- 3.1.3 -------------------------------------------------------------------- # BarrierBinomialTree # not yet implemented # --- 3.1.4 -------------------------------------------------------------------- # ConvertibleBond # not yet implemented # --- 3.2 ---------------------------------------------------------------------- # TrinomialTree # not yet implemented # --- 3.3 ---------------------------------------------------------------------- # ThreeDimensionalBinomialTree # PayoffFunction # not yet implemented # --- 3.4.1 -------------------------------------------------------------------- # ImpliedBinomialTree # not yet implemented # --- 3.4.2 -------------------------------------------------------------------- # ImpliedTrinomialTree # not yet implemented # ****************************************************************************** fOptions/R/HestonNandiGarchFit.R0000644000175100001440000004040012620131167016234 0ustar hornikusers # 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: # hngarchSim Simulates an HN-GARCH(1,1) Time Series Process # hngarchFit Fits a HN-GARCH model by Gaussian Maximum Likelihood # print.hngarch Print method, reports results # summary.hngarch Summary method, diagnostic analysis # hngarchStats Computes Unconditional Moments of a HN-GARCH Process ################################################################################ hngarchSim = function(model = list(lambda = 4, omega = 4*0.0002, alpha = 0.3*0.0002, beta = 0.3, gamma = 0, rf = 0), n = 1000, innov = NULL, n.start = 100, start.innov = NULL, rand.gen = rnorm, ...) { # A function implemented by Diethelm Wuertz # Description: # Simulates a HN-GARCH time series with user supplied innovations. # Details: # The function simulates a Heston Nandi Garch(1,1) process with # structure parameters specified through the list # `model(lambda, omega, alpha, beta, gamma, rf)' # The function returns the simulated time series points # neglecting those from the first "start.innov" innovations. # Example: # x = hngarch() # plot(100*x, type="l", xlab="Day numbers", # ylab="Daily Returns %", main="Heston Nandi GARCH") # S0 = 1 # plot(S0*exp(cumsum(x)), type="l", xlab="Day Numbers", # ylab="Daily Prices", main="Heston Nandi GARCH") } # FUNCTION: # Innovations: if (is.null(innov)) innov = rand.gen(n, ...) if (is.null(start.innov)) start.innov = rand.gen(n.start, ...) # Parameters: lambda = model$lambda omega = model$omega alpha = model$alpha beta = model$beta gamma = model$gamma rfr = model$rf # Start values: x = h = Z = c(start.innov, innov) nt = n.start + n # Recursion: h[1] = ( omega + alpha )/( 1 - alpha*gamma*gamma - beta ) x[1] = rfr + lambda*h[1] + sqrt(h[1]) * Z[1] for (i in 2:nt) { h[i] = omega + alpha*(Z[i-1] - gamma*sqrt(h[i-1]))^2 + beta*h[i-1] x[i] = rfr + lambda*h[i] + sqrt(h[i]) * Z[i] } # Series: x = x[-(1:n.start)] # Return Value: x } # ------------------------------------------------------------------------------ hngarchFit = function(x, model = list(lambda = -0.5, omega = var(x), alpha = 0.1*var(x), beta = 0.1, gamma = 0, rf = 0), symmetric = TRUE, trace = FALSE, title = NULL, description = NULL, ...) { # A function implemented by Diethelm Wuertz # Description: # Fits Heston-Nandi Garch(1,1) time series model # FUNCTION: # Parameters: rfr = model$rf lambda = model$lambda omega = model$omega alpha = model$alpha beta = model$beta gam = model$gamma # Continue: params = c(lambda = lambda, omega = omega, alpha = alpha, beta = beta, gamma = gam, rf = rfr) # Transform Parameters and Calculate Start Parameters: par.omega = -log((1-omega)/omega) # for 2 par.alpha = -log((1-alpha)/alpha) # for 3 par.beta = -log((1-beta)/beta) # for 4 par.start = c(lambda, par.omega, par.alpha, par.beta) if (!symmetric) par.start = c(par.start, gam) # Initial Log Likelihood: opt = list() opt$value = .llhHNGarch(par = par.start, trace = trace, symmetric = symmetric, rfr = rfr, x = x) opt$estimate = par.start if (trace) { print(c(lambda, omega, alpha, beta, gam)) print(opt$value) } # Estimate Parameters: opt = nlm(.llhHNGarch, par.start, trace = trace, symmetric = symmetric, rfr = rfr, x = x, ...) # Log-Likelihood: opt$minimum = -opt$minimum + length(x)*sqrt(2*pi) opt$params = params opt$symmetric = symmetric # LLH, h, and z for Final Estimates: final = .llhHNGarch(opt$estimate, trace = FALSE, symmetric, rfr, x) opt$h = attr(final, "h") opt$z = attr(final, "Z") # Backtransform Estimated parameters: lambda = opt$estimate[1] omega = opt$estimate[2] = (1 / (1+exp(-opt$estimate[2]))) alpha = opt$estimate[3] = (1 / (1+exp(-opt$estimate[3]))) beta = opt$estimate[4] = (1 / (1+exp(-opt$estimate[4]))) if (symmetric) opt$estimate[5] = 0 gam = opt$estimate[5] names(opt$estimate) = c("lambda", "omega", "alpha", "beta", "gamma") # Add to Output: opt$model = list(lambda = lambda, omega = omega, alpha = alpha, beta = beta, gamma = gam, rf = rfr) opt$x = x # Statistics - Printing: opt$persistence = beta + alpha*gam*gam opt$sigma2 = ( omega + alpha ) / ( 1 - opt$persistence ) # Print Estimated Parameters: if (trace) print(opt$estimate) # Call: opt$call = match.call() # Add title and description: if (is.null(title)) title = "Heston-Nandi Garch Parameter Estimation" opt$title = title if (is.null(description)) description = description() opt$description = description # Return Value: class(opt) = "hngarch" invisible(opt) } # ------------------------------------------------------------------------------ .llhHNGarch = function(par, trace, symmetric, rfr, x) { # h = sigma^2 h = Z = x lambda = par[1] # Transform - to keep them between 0 and 1: omega = 1 / (1+exp(-par[2])) alpha = 1 / (1+exp(-par[3])) beta = 1 / (1+exp(-par[4])) # Add gamma if selected: if (!symmetric) gam = par[5] else gam = 0 # HN Garch Filter: h[1] = ( omega + alpha )/( 1 - alpha*gam*gam - beta) Z[1] = ( x[1] - rfr - lambda*h[1] ) / sqrt(h[1]) for ( i in 2:length(Z) ) { h[i] = omega + alpha * ( Z[i-1] - gam * sqrt(h[i-1]) )^2 + beta * h[i-1] Z[i] = ( x[i] - rfr - lambda*h[i] ) / sqrt(h[i]) } # Calculate Log - Likelihood for Normal Distribution: llhHNGarch = -sum(log( dnorm(Z)/sqrt(h) )) if (trace) { cat("Parameter Estimate\n") print(c(lambda, omega, alpha, beta, gam)) } # Attribute Z and h to the result: attr(llhHNGarch, "Z") = Z attr(llhHNGarch, "h") = h # Return Value: llhHNGarch } # ------------------------------------------------------------------------------ print.hngarch = function(x, ...) { # A function implemented by Diethelm Wuertz # Description: # Print method for the HN-GARCH time series model. # Arguments: # x - an object of class "hngarch" as returned by the # function "hngarchFit" # FUNCTION: # Print: object = x if (!inherits(object, "hngarch")) stop("method is only for garch objects") # Title: cat("\nTitle:\n ") cat(object$title, "\n") # Call: cat("\nCall:\n ", deparse(object$call), "\n", sep = "") # Parameters: cat("\nParameters:\n") print(format(object$params, digits = 4, ...), print.gap = 2, quote = FALSE) # Coefficients: cat("\nCoefficients: lambda, omega, alpha, beta, gamma\n") print(format(object$estimate, digits = 4, ...), print.gap = 2, quote = FALSE) # Likelihood: cat("\nLog-Likelihood:\n ") cat(object$minimum, "\n") # Persisitence and Variance: cat("\nPersistence and Variance:\n ") cat(object$persistence, "\n ") cat(object$sigma2, "\n") # Description: cat("\nDescription:\n ") cat(object$description, "\n\n") # Return Value: invisible() } # ------------------------------------------------------------------------------ summary.hngarch = function(object, ...) { # A function implemented by Diethelm Wuertz # Description: # Summary method, # Computes diagnostics for a HN-GARCH time series model. # Arguments: # object - an object of class "hngarch" as returned by the # function "hngarchFit" # FUNCTION: # Print: if (!inherits(object, "hngarch")) stop("method is only for garch objects") # Title: cat("\nTitle:\n") cat(object$title, "\n") # Call: cat("\nCall:\n", deparse(object$call), "\n", sep = "") # Parameters: cat("\nParameters:\n") print(format(object$params, digits = 4, ...), print.gap = 2, quote = FALSE) # Coefficients: cat("\nCoefficients: lambda, omega, alpha, beta, gamma\n") print(format(object$estimate, digits = 4, ...), print.gap = 2, quote = FALSE) # Likelihood: cat("\nLog-Likelihood:\n") cat(object$minimum, "\n") # Persisitence and Variance: cat("\nPersistence and Variance:\n") cat(object$persistence, "\n") cat(object$sigma2, "\n") # Create Graphs: plot(x = object$x, type = "l", xlab = "Days", ylab = "log-Returns", main = "Log-Returns", ...) plot(sqrt(object$h), type = "l", xlab = "Days", ylab = "sqrt(h)", main = "Conditional Standard Deviations", ...) # ... there are not resiudal yet implemented: # plot(object$residuals, type = "l", xlab = "Days", ylab = "Z", # main = "Residuals", ...) # Return Value: invisible() } ################################################################################ hngarchStats = function(model) { # A function implemented by Diethelm Wuertz # Description: # Details: # Calculates the first 4 moments of the unconditional log # return distribution for a stationary HN GARCH(1,1) process # with standard normally distributed innovations. The function # returns a list with the theoretical values for the mean, the # variance, the skewness and the kurtosis} of the (unconditional) # log return distribution. We have also access to the persistence # of the corresponding HN GARCH(1,1) process and to the values # for E[sigma^2], E[sigma^4], E[sigma^6], and E[sigma^8], which are # needed for the computation of the moments of the unconditional # log return distribution. The only arguments are the risk free # interest rate r and the structure parameters of the HN GARCH(1,1) # process, which are specified in the model list model=list(alpha, # beta, omega, gamma, lambda)}. # Reference: # A function originally written by Reto Angliker # License: GPL # Arguments: # model - a moel specification for a Heston-Nandi Garch # process. # FUNCTION: # Check: if (model$alpha < 0) { warning("Negative value for the parameter alpha")} if (model$beta < 0) {warning("Negative value for the parameter beta") } if (model$omega < 0) {warning("Negative value for the parameter omega")} # Short: lambda = model$lambda omega = model$omega alpha = model$alpha beta = model$beta gamma = model$gamma # Moments of the Normal Distribution expect2 = 1 expect4 = 3 expect6 = 15 expect8 = 105 # Symmetric Case: if(model$gamma == 0) { persistence = beta meansigma2 = (omega+alpha) /(1-beta) meansigma4 = (omega^2 + 2*omega*alpha + 2*omega*beta*meansigma2 + 3*alpha^2 + 2*alpha*beta*meansigma2) / (1 - beta^2) meansigma6 = (omega^3 + 3*omega^2*alpha + 3*omega^2*beta*meansigma2 + 9*omega*alpha^2 + 6*omega*alpha*beta*meansigma2 + 3*omega*beta^2*meansigma4 + 15*alpha^3 + 9*alpha^2*beta*meansigma2 + 3*alpha*beta^2*meansigma4) / (1-beta^3) meansigma8 = (omega^4 + expect8*alpha^4 + 12*omega^2*alpha*beta*meansigma2 + 60*alpha^3*beta*meansigma2 + 18*alpha^2*beta^2*meansigma4 + 4*alpha*beta^3*meansigma6 + 36*omega*alpha^2*beta*meansigma2 + 12*omega*alpha*beta^2*meansigma4 + 4*omega^3*alpha + 4*omega^3*beta*meansigma2 + 18*omega^2*alpha^2 + 6*omega^2*beta^2*meansigma4 + 60*omega*alpha^3 + 4*omega*beta^3*meansigma6)/ (1 - beta^4) } # Asymmetric Case: if(gamma != 0) { persistence = beta + alpha*gamma^2 meansigma2 = (omega+alpha) / (1-beta-alpha*gamma^2) meansigma4 = (omega^2 + 2*omega*beta*meansigma2 + alpha^2*expect4 + 2*beta*meansigma2*alpha*expect2 + 6*alpha^2*expect2*gamma^2*meansigma2 + 2*omega*alpha*gamma^2*meansigma2 + 2*omega*alpha*expect2) / (1 - beta^2 - 2*beta*alpha*gamma^2 - alpha^2*gamma^4) meansigma6 = (3*omega*alpha^2*expect4 + 3*omega^2*alpha*gamma^2*meansigma2 + 3*beta*meansigma2*alpha^2*expect4 + 3*beta^2*meansigma4*alpha*expect2 + 15*alpha^3*expect4*gamma^2*meansigma2 + 15*alpha^3*expect2*gamma^4*meansigma4 + 3*omega*alpha^2*gamma^4*meansigma4 + 3*omega^2*beta*meansigma2 + 3*omega^2*alpha*expect2 + 3*omega*beta^2*meansigma4 + omega^3 + alpha^3*expect6 + 18*beta*meansigma4*alpha^2*expect2*gamma^2 + 6*omega*beta*meansigma2*alpha*expect2 + 6*omega*beta*meansigma4*alpha*gamma^2 + 18*omega*alpha^2*expect2*gamma^2*meansigma2) / (1 - 3*beta^2*alpha*gamma^2 - 3*beta*alpha^2*gamma^4 - alpha^3*gamma^6 - beta^3) meansigma8 = (omega^4 + alpha^4*expect8 + 6*omega^2*alpha^2*expect4 + 4*omega^3*beta*meansigma2 + 4*omega^3*alpha*expect2 + 6*omega^2*beta^2*meansigma4 + 4*omega*beta^3*meansigma6 + 4*omega*alpha^3*expect6 + 12*omega^2*beta*meansigma2*alpha*expect2 + 12*omega^2*beta*meansigma4*alpha*gamma^2 + 36*omega^2*alpha^2*expect2*gamma^2*meansigma2 + 4*omega^3*alpha*gamma^2*meansigma2 + 6*omega^2*alpha^2*gamma^4*meansigma4 + 6*beta^2*meansigma4*alpha^2*expect4 + 4*beta^3*meansigma6*alpha*expect2 + 4*beta*meansigma2*alpha^3*expect6 + 28*alpha^4*expect6*gamma^2*meansigma2 + 70*alpha^4*expect4*gamma^4*meansigma4 + 28*alpha^4*expect2*gamma^6*meansigma6 + 4*omega*alpha^3*gamma^6*meansigma6 + 60*beta*meansigma4*alpha^3*expect4*gamma^2 + 60* beta*meansigma6*alpha^3*expect2*gamma^4 + 36*beta^2*meansigma6*alpha^2*expect2*gamma^2 + 12*omega*beta*meansigma2*alpha^2*expect4 + 12*omega*beta^2*meansigma4*alpha*expect2 + 12*omega*beta^2*meansigma6*alpha*gamma^2 + 12*omega*beta*meansigma6*alpha^2*gamma^4 + 60*omega*alpha^3*expect4*gamma^2*meansigma2 + 60*omega*alpha^3*expect2*gamma^4*meansigma4 + 72*omega*beta*meansigma4*alpha^2*expect2*gamma^2) / (1 - beta^4 - alpha^4*gamma^8 - 4*beta^3*alpha*gamma^2 - 6*beta^2*alpha^2*gamma^4 - 4*beta*alpha^3*gamma^6 ) } if (persistence > 1) { warning(paste( "The selected HN GARCH model is not stationary and", "the expressions for the moments are no more valid")) } # Leverage: leverage = -2*alpha*gamma*meansigma2 # Unconditional Values: uc.mean = lambda*meansigma2 uc.variance = lambda^2*(meansigma4 - meansigma2^2) + meansigma2 uc.skewness = (3*lambda*meansigma4 - 3*lambda*meansigma2^2 + lambda^3*meansigma6 - 3*lambda^3*meansigma2*meansigma4 + 2*lambda^3*meansigma2^3 ) / sqrt(uc.variance)^3 uc.kurtosis = (meansigma4*3 + 6*lambda^2*meansigma6 - 12*lambda^2*meansigma2*meansigma4 + 6*lambda^2*meansigma2^3 + lambda^4*meansigma8 - 4*lambda^4*meansigma2*meansigma6 + 6*lambda^4*meansigma2^2*meansigma4 - 3*lambda^4*meansigma2^4 ) / uc.variance^2 # Return Value: list(mean = uc.mean, variance = uc.variance, skewness = uc.skewness, kurtosis = uc.kurtosis, persistence = persistence, leverage = leverage, meansigma2 = meansigma2, meansigma4 = meansigma4, meansigma6 = meansigma6, meansigma8 = meansigma8) } ################################################################################ fOptions/R/HestonNandiOptions.R0000644000175100001440000001656412620131167016216 0ustar hornikusers # 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: # HNGOption Computes Option Price from the HN-GARCH Formula # HNGGreeks Calculates one of the Greeks of the HN-GARCH Formula # HNGCharacteristics Computes Option Price and all Greeks of HN-GARCH Model ################################################################################ HNGOption = function(TypeFlag = c("c", "p"), model, S, X, Time.inDays, r.daily) { # A function implemented by Diethelm Wuertz # Description: # Calculates the price of a HN-GARCH option. # Details: # The function calculates the price of a Heston-Nandi GARCH(1,1) # call or put option. # FUNCTION: # Option Type: TypeFlag = TypeFlag[1] # Integrate: call1 = integrate(.fstarHN, 0, Inf, const = 1, model = model, S = S, X = X, Time.inDays = Time.inDays, r.daily = r.daily) # For SPlus Compatibility: if (is.null(call1$value)) call1$value = call1$integral call2 = integrate(.fstarHN, 0, Inf, const = 0, model = model, S = S, X = X, Time.inDays = Time.inDays, r.daily = r.daily) # For SPlus Compatibility: if (is.null(call2$value)) call2$value = call2$integral # Compute Call Price: call.price = S/2 + exp(-r.daily*Time.inDays) * call1$value - X * exp(-r.daily*Time.inDays) * ( 1/2 + call2$value ) # Select Option Price: price = NA if (TypeFlag == "c" ) price = call.price if (TypeFlag == "p" ) price = call.price + X*exp(-r.daily*Time.inDays) - S # Return Value: option = list( price = price, call = match.call()) class(option) = "option" option } .fstarHN <- function(phi, const, model, S, X, Time.inDays, r.daily) { # Internal Function: # Model Parameters: lambda = -1/2 omega = model$omega alpha = model$alpha gamma = model$gamma + model$lambda + 1/2 beta = model$beta sigma2 = (omega + alpha)/(1 - beta - alpha * gamma^2) # Function to be integrated: cphi0 = phi*complex(real = 0, imaginary = 1) cphi = cphi0 + const a = cphi * r.daily b = lambda*cphi + cphi*cphi/2 for (i in 2:Time.inDays) { a = a + cphi*r.daily + b*omega - log(1-2*alpha*b)/2 b = cphi*(lambda+gamma) - gamma^2/2 + beta*b + 0.5*(cphi-gamma)^2/(1-2*alpha*b) } f = Re(exp(-cphi0*log(X)+cphi*log(S)+a+b*sigma2 )/cphi0)/pi # Return Value: f } # ------------------------------------------------------------------------------ HNGGreeks = function(Selection = c("Delta", "Gamma"), TypeFlag = c("c", "p"), model, S, X, Time.inDays, r.daily) { # A function implemented by Diethelm Wuertz # Description: # Calculates the Greeks of a HN-GARCH option. # Details: # The function calculates the delta and gamma Greeks of # a Heston Nandi GARCH(1,1) call or put option. # FUNCTION: # Type Flags: Selection = Selection[1] TypeFlag = TypeFlag[1] # Delta: if (Selection == "Delta") { # Integrate: delta1 = integrate(.fdeltaHN, 0, Inf, const = 1, model = model, S = S, X = X, Time.inDays = Time.inDays, r.daily = r.daily) # For SPlus Compatibility: if (is.null(delta1$value)) delta1$value = delta1$integral delta2 = integrate(.fdeltaHN, 0, Inf, const = 0, model = model, S = S, X = X, Time.inDays = Time.inDays, r.daily = r.daily) # For SPlus Compatibility: if (is.null(delta2$value)) delta2$value = delta2$integral # Compute Call and Put Delta : greek = 1/2 + exp(-r.daily*Time.inDays) * delta1$value - X * exp(-r.daily*Time.inDays) * delta2$value if (TypeFlag == "p") greek = greek - 1 } # Gamma: if (Selection == "Gamma") { # Integrate: gamma1 = integrate(.fgammaHN, 0, Inf, const = 1, model = model, S = S, X = X, Time.inDays = Time.inDays, r.daily = r.daily) # For SPlus Compatibility: if (is.null(gamma1$value)) gamma1$value = gamma1$integral gamma2 = integrate(.fgammaHN, 0, Inf, const = 0, model = model, S = S, X = X, Time.inDays = Time.inDays, r.daily = r.daily) # For SPlus Compatibility: if (is.null(gamma2$value)) gamma2$value = gamma2$integral # Compute Call and Put Gamma : greek = put.gamma = exp(-r.daily*Time.inDays) * gamma1$value - X * exp(-r.daily*Time.inDays) * gamma2$value } # Return Value: greek } .fdeltaHN <- function(phi, const, model, S, X, Time.inDays, r.daily) { # Function to be integrated: cphi0 = phi * complex(real = 0, imaginary = 1) cphi = cphi0 + const fdelta = cphi * .fHN(phi, const, model, S, X, Time.inDays, r.daily) / S # Return Value: Re(fdelta) } .fgammaHN <- function(phi, const, model, S, X, Time.inDays, r.daily) { # Function to be integrated: cphi0 = phi * complex(real = 0, imaginary = 1) cphi = cphi0 + const fgamma = cphi * ( cphi - 1 ) * .fHN(phi, const, model, S, X, Time.inDays, r.daily) / S^2 # Return Value: Re(fgamma) } .fHN <- function(phi, const, model, S, X, Time.inDays, r.daily) { # Internal Function: # Model Parameters: lambda = -1/2 omega = model$omega alpha = model$alpha gamma = model$gamma + model$lambda + 1/2 beta = model$beta sigma2 = (omega + alpha)/(1 - beta - alpha * gamma^2) # Function to be integrated: cphi0 = phi*complex(real = 0, imaginary = 1) cphi = cphi0 + const a = cphi * r.daily b = lambda*cphi + cphi*cphi/2 for (i in 2:Time.inDays) { a = a + cphi*r.daily + b*omega - log(1-2*alpha*b)/2 b = cphi*(lambda+gamma) - gamma^2/2 + beta*b + 0.5*(cphi-gamma)^2/(1-2*alpha*b) } fun = exp(-cphi0*log(X)+cphi*log(S)+a+b*sigma2)/cphi0/pi # Return Value: fun } # ------------------------------------------------------------------------------ HNGCharacteristics = function(TypeFlag = c("c", "p"), model, S, X, Time.inDays, r.daily) { # A function implemented by Diethelm Wuertz # Description: # The function calculates the option price for the Heston # Nandi Garch(1,1) option model together with the delta # and gamma option sensitivies. # FUNCTION: # Premium and Function Call to all Greeks TypeFlag = TypeFlag[1] premium = HNGOption(TypeFlag, model, S, X, Time.inDays, r.daily) delta = HNGGreeks("Delta", TypeFlag, model, S, X, Time.inDays, r.daily) gamma = HNGGreeks("Gamma", TypeFlag, model, S, X, Time.inDays, r.daily) # Return Value: list(premium = premium, delta = delta, gamma = gamma) } ################################################################################ fOptions/R/fOptionsEnv.R0000644000175100001440000000275412620131167014676 0ustar hornikusers # 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 ############################################################################### .fOptionsEnv <- new.env(hash = TRUE) .setfOptionsEnv <- function(...) { x <- list(...) nm <- names(x) if (is.null(nm) || "" %in% nm) stop("all arguments must be named") sapply(nm, function(nm) assign(nm, x[[nm]], envir = .fOptionsEnv)) invisible() } .getfOptionsEnv <- function(x = NULL, unset = "") { if (is.null(x)) x <- ls(all.names = TRUE, envir = .fOptionsEnv) ### unlist(mget(x, envir = .fOptionsEnv, mode = "any", ### ifnotfound = as.list(unset)), recursive = FALSE) get(x, envir = .fOptionsEnv, mode = "any") } ############################################################################### fOptions/R/PlainVanillaOptions.R0000644000175100001440000004357212620131167016355 0ustar hornikusers # 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: # 'fOPTION' S4 Class Representation # FUNCTION: DESCRIPTION: # NDF Normal distribution function # CND Cumulative normal distribution function # CBND Cumulative bivariate normal distribution # FUNCTION: DESCRIPTION: # GBSOption Computes Option Price from the GBS Formula # GBSCharacteristics Computes Option Price and all Greeks of GBS Model # BlackScholesOption Synonyme Function Call to GBSOption # GBSGreeks Computes one of the Greeks of the GBS formula # FUNCTION: DESCRIPTION: # Black76Option Computes Prices of Options on Futures # MiltersenSchwartzOption Pricing a Miltersen Schwartz Option # S3 METHODS: DESCRIPTION: # print.option Print Method # summary.otion Summary Method ################################################################################ setClass("fOPTION", representation( call = "call", parameters = "list", price = "numeric", title = "character", description = "character" ) ) ################################################################################ NDF = function(x) { # A function implemented by Diethelm Wuertz # Description: # Calculate the normal distribution function. # FUNCTION: # Compute: result = exp(-x*x/2)/sqrt(8*atan(1)) # Return Value: result } # ------------------------------------------------------------------------------ CND = function(x) { # A function implemented by Diethelm Wuertz # Description: # Calculate the cumulated normal distribution function. # References: # Haug E.G., The Complete Guide to Option Pricing Formulas # FUNCTION: # Compute: k = 1 / ( 1 + 0.2316419 * abs(x) ) a1 = 0.319381530; a2 = -0.356563782; a3 = 1.781477937 a4 = -1.821255978; a5 = 1.330274429 result = NDF(x) * (a1*k + a2*k^2 + a3*k^3 + a4*k^4 + a5*k^5) - 0.5 result = 0.5 - result*sign(x) # Return Value: result } # ------------------------------------------------------------------------------ CBND = function(x1, x2, rho) { # A function implemented by Diethelm Wuertz # Description: # Calculate the cumulative bivariate normal distribution function. # References: # Haug E.G., The Complete Guide to Option Pricing Formulas # FUNCTION: # Compute: # Take care for the limit rho = +/- 1 a = x1 b = x2 if (abs(rho) == 1) rho = rho - (1e-12)*sign(rho) # cat("\n a - b - rho :"); print(c(a,b,rho)) X = c(0.24840615, 0.39233107, 0.21141819, 0.03324666, 0.00082485334) y = c(0.10024215, 0.48281397, 1.0609498, 1.7797294, 2.6697604) a1 = a / sqrt(2 * (1 - rho^2)) b1 = b / sqrt(2 * (1 - rho^2)) if (a <= 0 && b <= 0 && rho <= 0) { Sum1 = 0 for (I in 1:5) { for (j in 1:5) { Sum1 = Sum1 + X[I] * X[j] * exp(a1*(2*y[I]-a1) + b1*(2*y[j]-b1) + 2*rho*(y[I]-a1)*(y[j]-b1)) } } result = sqrt(1 - rho^2) / pi * Sum1 return(result) } if (a <= 0 && b >= 0 && rho >= 0) { result = CND(a) - CBND(a, -b, -rho) return(result) } if (a >= 0 && b <= 0 && rho >= 0) { result = CND(b) - CBND(-a, b, -rho) return(result) } if (a >= 0 && b >= 0 && rho <= 0) { result = CND(a) + CND(b) - 1 + CBND(-a, -b, rho) return(result) } if (a * b * rho >= 0 ) { rho1 = (rho*a - b) * sign(a) / sqrt(a^2 - 2*rho*a*b + b^2) rho2 = (rho*b - a) * sign(b) / sqrt(a^2 - 2*rho*a*b + b^2) delta = (1 - sign(a) * sign(b)) / 4 result = CBND(a, 0, rho1) + CBND(b, 0, rho2) - delta return(result) } # Return Value: invisible() } # ****************************************************************************** GBSOption = function(TypeFlag = c("c", "p"), S, X, Time, r, b, sigma, title = NULL, description = NULL) { # A function implemented by Diethelm Wuertz # Description: # Calculate the Generalized Black-Scholes option # price either for a call or a put option. # References: # Haug E.G., The Complete Guide to Option Pricing Formulas # FUNCTION: # Compute: TypeFlag = TypeFlag[1] d1 = ( log(S/X) + (b+sigma*sigma/2)*Time ) / (sigma*sqrt(Time)) d2 = d1 - sigma*sqrt(Time) if (TypeFlag == "c") result = S*exp((b-r)*Time)*CND(d1) - X*exp(-r*Time)*CND(d2) if (TypeFlag == "p") result = X*exp(-r*Time)*CND(-d2) - S*exp((b-r)*Time)*CND(-d1) # Parameters: 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 = "Black Scholes 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 ) } # ------------------------------------------------------------------------------ GBSCharacteristics = function(TypeFlag = c("c", "p"), S, X, Time, r, b, sigma) { # A function implemented by Diethelm Wuertz # Description: # Calculate the Options Characterisitics (Premium # and Greeks for a Generalized Black-Scholes option # either for a call or a put option. # References: # Haug E.G., The Complete Guide to Option Pricing Formulas # FUNCTION: # Premium and Function Call to all Greeks TypeFlag = TypeFlag[1] premium = GBSOption(TypeFlag, S, X, Time, r, b, sigma)@price delta = GBSGreeks("Delta", TypeFlag, S, X, Time, r, b, sigma) theta = GBSGreeks("Theta", TypeFlag, S, X, Time, r, b, sigma) vega = GBSGreeks("Vega", TypeFlag, S, X, Time, r, b, sigma) rho = GBSGreeks("Rho", TypeFlag, S, X, Time, r, b, sigma) lambda = GBSGreeks("Lambda", TypeFlag, S, X, Time, r, b, sigma) gamma = GBSGreeks("Gamma", TypeFlag, S, X, Time, r, b, sigma) # Return Value: list(premium = premium, delta = delta, theta = theta, vega = vega, rho = rho, lambda = lambda, gamma = gamma) } # ------------------------------------------------------------------------------ BlackScholesOption = function(...) { # A function implemented by Diethelm Wuertz # Description: # A synonyme for GBSOption # FUNCTION: # Return Value: GBSOption(...) } # ****************************************************************************** GBSGreeks = function(Selection = c("Delta", "Theta", "Vega", "Rho", "Lambda", "Gamma", "CofC"), TypeFlag = c("c", "p"), S, X, Time, r, b, sigma) { # A function implemented by Diethelm Wuertz # Description: # Calculate the Options Greeks for a Generalized # Black-Scholes option either for a call or a put option. # References: # Haug E.G., The Complete Guide to Option Pricing Formulas # FUNCTION: # Settings: TypeFlag = TypeFlag[1] Selection = Selection[1] # Function Call to all Greeks via selection parameter result = NA if (Selection == "Delta" || Selection == "delta") result = .GBSDelta (TypeFlag, S, X, Time, r, b, sigma) if (Selection == "Theta" || Selection == "theta") result = .GBSTheta (TypeFlag, S, X, Time, r, b, sigma) if (Selection == "Vega" || Selection == "vega") result = .GBSVega (TypeFlag, S, X, Time, r, b, sigma) if (Selection == "Rho" || Selection == "rho") result = .GBSRho (TypeFlag, S, X, Time, r, b, sigma) if (Selection == "Lambda" || Selection == "lambda") result = .GBSLambda(TypeFlag, S, X, Time, r, b, sigma) if (Selection == "Gamma" || Selection == "gamma") result = .GBSGamma (TypeFlag, S, X, Time, r, b, sigma) if (Selection == "CofC" || Selection == "cofc") result = .GBSCofC (TypeFlag, S, X, Time, r, b, sigma) # Return Value: result } # Internal Functions: .GBSDelta <- function(TypeFlag, S, X, Time, r, b, sigma) { d1 = ( log(S/X) + (b+sigma*sigma/2)*Time ) / (sigma*sqrt(Time)) if (TypeFlag == "c") result = exp((b-r)*Time)*CND(d1) if (TypeFlag == "p") result = exp((b-r)*Time)*(CND(d1)-1) result } .GBSTheta <- function(TypeFlag, S, X, Time, r, b, sigma) { d1 = ( log(S/X) + (b+sigma*sigma/2)*Time ) / (sigma*sqrt(Time)) d2 = d1 - sigma*sqrt(Time) Theta1 = -(S*exp((b-r)*Time)*NDF(d1)*sigma)/(2*sqrt(Time)) if (TypeFlag == "c") result = Theta1 - (b-r)*S*exp((b-r)*Time)*CND(+d1) - r*X*exp(-r*Time)*CND(+d2) if (TypeFlag == "p") result = Theta1 + (b-r)*S*exp((b-r)*Time)*CND(-d1) + r*X*exp(-r*Time)*CND(-d2) result } .GBSVega <- function(TypeFlag, S, X, Time, r, b, sigma) { d1 = ( log(S/X) + (b+sigma*sigma/2)*Time ) / (sigma*sqrt(Time)) result = S*exp((b-r)*Time)*NDF(d1)*sqrt(Time) # Call,Put result } .GBSRho <- function(TypeFlag, S, X, Time, r, b, sigma) { d1 = ( log(S/X) + (b+sigma*sigma/2)*Time ) / (sigma*sqrt(Time)) d2 = d1 - sigma*sqrt(Time) CallPut = GBSOption(TypeFlag, S, X, Time, r, b , sigma)@price if (TypeFlag == "c") { if (b != 0) {result = Time * X * exp(-r*Time)*CND( d2)} else {result = -Time * CallPut } } if (TypeFlag == "p") { if (b != 0) {result = -Time * X * exp(-r*Time)*CND(-d2)} else { result = -Time * CallPut } } result } .GBSLambda <- function(TypeFlag, S, X, Time, r, b, sigma) { d1 = ( log(S/X) + (b+sigma*sigma/2)*Time ) / (sigma*sqrt(Time)) CallPut = GBSOption(TypeFlag,S,X,Time,r,b,sigma)@price if (TypeFlag == "c") result = exp((b-r)*Time)* CND(d1)*S / CallPut if (TypeFlag == "p") result = exp((b-r)*Time)*(CND(d1)-1)*S / CallPut result } .GBSGamma <- function(TypeFlag, S, X, Time, r, b, sigma) { d1 = ( log(S/X) + (b+sigma*sigma/2)*Time ) / (sigma*sqrt(Time)) result = exp((b-r)*Time)*NDF(d1)/(S*sigma*sqrt(Time)) # Call,Put result } .GBSCofC <- function(TypeFlag, S, X, Time, r, b, sigma) { d1 = ( log(S/X) + (b+sigma*sigma/2)*Time ) / (sigma*sqrt(Time)) if (TypeFlag == "c") result = Time*S*exp((b-r)*Time)*CND(d1) if (TypeFlag == "p") result = -Time*S*exp((b-r)*Time)*CND(-d1) result } # ------------------------------------------------------------------------------ Black76Option = function(TypeFlag = c("c", "p"), FT, X, Time, r, sigma, title = NULL, description = NULL) { # A function implemented by Diethelm Wuertz # Description: # Calculate Options Price for Black (1977) Options # on futures/forwards # References: # Haug E.G., The Complete Guide to Option Pricing Formulas # FUNCTION: # Settings: TypeFlag = TypeFlag[1] # Result: result = GBSOption(TypeFlag = TypeFlag, S = FT, X = X, Time = Time, r = r, b = 0, sigma = sigma)@price # Parameters: param = list() param$TypeFlag = TypeFlag param$FT = FT param$X = X param$Time = Time param$r = r param$sigma = sigma # Add title and description: if (is.null(title)) title = "Black 76 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 ) } # ****************************************************************************** MiltersenSchwartzOption = function (TypeFlag = c("c", "p"), Pt, FT, X, time, Time, sigmaS, sigmaE, sigmaF, rhoSE, rhoSF, rhoEF, KappaE, KappaF, title = NULL, description = NULL) { # A function implemented by Diethelm Wuertz # Description: # Miltersen Schwartz (1997) commodity option model. # References: # Haug E.G., The Complete Guide to Option Pricing Formulas # FUNCTION: # Settings: TyoeFlag = TypeFlag[1] # Compute: vz = sigmaS^2*time+2*sigmaS*(sigmaF*rhoSF*1/KappaF*(time-1/KappaF* exp(-KappaF*Time)*(exp(KappaF*time)-1))-sigmaE*rhoSE*1/KappaE* (time-1/KappaE*exp(-KappaE*Time)*(exp(KappaE*time)-1)))+sigmaE^2* 1/KappaE^2*(time+1/(2*KappaE)*exp(-2*KappaE*Time)*(exp(2*KappaE*time)- 1)-2*1/KappaE*exp(-KappaE*Time)*(exp(KappaE*time)-1))+sigmaF^2* 1/KappaF^2*(time+1/(2*KappaF)*exp(-2*KappaF*Time)*(exp(2*KappaF*time)- 1)-2*1/KappaF*exp(-KappaF*Time)*(exp(KappaF*time)-1))-2*sigmaE* sigmaF*rhoEF*1/KappaE*1/KappaF*(time-1/KappaE*exp(-KappaE*Time)* (exp(KappaE*time)-1)-1/KappaF*exp(-KappaF*Time)*(exp(KappaF*time)- 1)+1/(KappaE+KappaF)*exp(-(KappaE+KappaF)*Time)*(exp((KappaE+KappaF)* time)-1)) vxz = sigmaF*1/KappaF*(sigmaS*rhoSF*(time-1/KappaF*(1-exp(-KappaF* time)))+sigmaF*1/KappaF*(time-1/KappaF*exp(-KappaF*Time)*(exp(KappaF* time)-1)-1/KappaF*(1-exp(-KappaF*time))+1/(2*KappaF)*exp(-KappaF* Time)*(exp(KappaF*time)-exp(-KappaF*time)))-sigmaE*rhoEF*1/KappaE* (time-1/KappaE*exp(-KappaE*Time)*(exp(KappaE*time)-1)-1/KappaF*(1- exp(-KappaF*time))+1/(KappaE+KappaF)*exp(-KappaE*Time)* (exp(KappaE*time)-exp(-KappaF*time)))) vz = sqrt(vz) d1 = (log(FT/X)-vxz+vz^2/2)/vz d2 = (log(FT/X)-vxz-vz^2/2)/vz # Call/Put: if (TypeFlag == "c") { result = Pt*(FT*exp(-vxz)*CND(d1)-X*CND(d2)) } if (TypeFlag == "p") { result = Pt*(X*CND(-d2)-FT*exp(-vxz)*CND(-d1)) } # Parameters: param = list() param$TypeFlag = TypeFlag param$Pt = Pt param$FT = FT param$X = X param$time = time param$Time = Time param$sigmaS = sigmaS param$sigmaE = sigmaE param$sigmaF = sigmaF param$rhoSE = rhoSE param$rhoSF = rhoSF param$rhoEF = rhoEF param$KappaE = KappaE param$KappaF = KappaF # Add title and description: if (is.null(title)) title = "Miltersen Schwartz 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 ) } # ****************************************************************************** GBSVolatility = function(price, TypeFlag = c("c", "p"), S, X, Time, r, b, tol = .Machine$double.eps, maxiter = 10000) { # A function implemented by Diethelm Wuertz # Description: # Compute implied volatility # Example: # sigma = GBSVolatility(price=10.2, "c", S=100, X=90, Time=1/12, r=0, b=0) # sigma # GBSOption("c", S=100, X=90, Time=1/12, r=0, b=0, sigma=sigma)@price # FUNCTION: # Option Type: TypeFlag = TypeFlag[1] # Search for Root: volatility = uniroot(.fGBSVolatility, interval = c(-10,10), price = price, TypeFlag = TypeFlag, S = S, X = X, Time = Time, r = r, b = b, tol = tol, maxiter = maxiter)$root # Return Value: volatility } # Internal Function: .fGBSVolatility <- function(x, price, TypeFlag, S, X, Time, r, b, ...) { GBS = GBSOption(TypeFlag = TypeFlag, S = S, X = X, Time = Time, r = r, b = b, sigma = x)@price price - GBS } # ------------------------------------------------------------------------------ print.option = function(x, ...) { # A function implemented by Diethelm Wuertz # Description: # Print method for objects of class "option". # FUNCTION: # Print Method: object = x cat("\nCall:", deparse(object$call), "", sep = "\n") cat("Option Price:\n") cat(object$price, "\n") } # ------------------------------------------------------------------------------ summary.option = function(object, ...) { # A function implemented by Diethelm Wuertz # Description: # Summary method for objects of class "option". # FUNCTION: # Summary Method: print(object, ...) } ################################################################################ setMethod("show", "fOPTION", function(object) { # A function implemented by Diethelm Wuertz # Description: # Print method for objects of class "fOPTION". # FUNCTION: # Print Method: Parameter = unlist(object@parameters) Names = names(Parameter) Parameter = cbind(as.character(Parameter)) rownames(Parameter) = paste("", Names) colnames(Parameter) = "Value:" # Title: cat("\nTitle:\n ") cat(object@title, "\n") # Call: cat("\nCall:", paste("", deparse(object@call)), "", sep = "\n") # Parameters: cat("Parameters:\n") print(Parameter, quote = FALSE) # Price: cat("\nOption Price:\n ") cat(object@price, "\n") # Description: cat("\nDescription:\n ") cat(object@description, "\n\n") # Return Value: invisible() }) # ------------------------------------------------------------------------------ summary.fOPTION = function(object, ...) { # A function implemented by Diethelm Wuertz # Description: # Summary method for objects of class "option". # FUNCTION: # Summary Method: print(object, ...) } ################################################################################ fOptions/R/zzz.R0000644000175100001440000000360012620131167013250 0ustar hornikusers # 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 fOptions" ) packageStartupMessage( "Pricing and Evaluating Basic 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" ) } ############################################################################### .onLoad <- function(libname, pkgname) { .setfOptionsEnv(.runif.halton.seed = list()) .setfOptionsEnv(.rnorm.halton.seed = list()) .setfOptionsEnv(.runif.sobol.seed = list()) .setfOptionsEnv(.rnorm.sobol.seed = list()) } ############################################################################### fOptions/MD50000644000175100001440000000365512620144160012406 0ustar hornikusersf3b55c5716a459a781f46d93b24a3ad1 *ChangeLog 15714540d775d957caab3a81be8648b9 *DESCRIPTION 2e0892bc1cd79bdc3c2158c6856baeb1 *NAMESPACE 3b03c603cd984bd44f208b3a0cfac098 *R/BasicAmericanOptions.R 3999361387fd70334d93eabb55eabf28 *R/BinomialTreeOptions.R aced832af546528f9af9f032c171b09b *R/HestonNandiGarchFit.R de733c16f6dfc645cedfe0b7b642650f *R/HestonNandiOptions.R 2c6b87659e0285c99863e1ac42c2f55c *R/LowDiscrepancy.R 439ad25a02c0a3efc6f6dc437520d1d2 *R/MonteCarloOptions.R a51bcfc053b5a7be39c4b9ac93432ff1 *R/PlainVanillaOptions.R 597b46b7f852c9fa6b85184b11c8d713 *R/fOptionsEnv.R 0831bd4a1ea68d521ae40ebfea2f07ce *R/zzz.R 6042b9c5e5bec3ecc1b6959cd2858b64 *inst/COPYRIGHT.html 6833c37bb27a1dab283e65e5672ecee5 *inst/unitTests/Makefile fba9d720010c0ac6564a9ed3b89a42e8 *inst/unitTests/runTests.R 839e1780db96f22c8eeba16ae9a25cfa *inst/unitTests/runit.BasicAmericanOptions.R 94ad9334e06ed8a493a2a7eca8adcc84 *inst/unitTests/runit.BinomialTreeOptions.R 28eae833137ecbda37da909dd0cf5d7e *inst/unitTests/runit.HestonNandiGarchFit.R 28bc62719179cdb3390c48a70c640145 *inst/unitTests/runit.HestonnandiGarchOption.R 2516954efef90d9920c7d26954df29c7 *inst/unitTests/runit.LowDiscrepancy.R 1ca64c6a59bb46c16b6f028e32faeeb8 *inst/unitTests/runit.MonteCarloOptions.R 6c82cb52ec5dbbe5242ba50edfc223ec *inst/unitTests/runit.PlainVanillaOptions.R b7789515cf344b6449e5699a0b7fc911 *man/00fOptions-package.Rd 95a12de45860ba19a3c88d7000605091 *man/BasicAmericanOptions.Rd 40fbb867428b242f4bb052897afc57ed *man/BinomialTreeOptions.Rd 04be047d7af7f1f4c650d6e4fd82b8b3 *man/HestonNandiGarchFit.Rd 58463c1aea2dd3a16f64bb0d79e657f4 *man/HestonNandiOptions.Rd ba362790de611adac6be71a4aecd2cae *man/LowDiscrepancy.Rd 58feb8718bd21ead1589c5a20e8e001e *man/MonteCarloOptions.Rd b67011eaf073059bb443b8e66e001d7d *man/PlainVanillaOptions.Rd ac2f961e99b1c81e181152e51a224768 *src/LowDiscrepancy.f 3996e7c16bfb96fad295ee425815cb4d *src/Makevars ca566e590ec30abd0718c5375e1a446f *tests/doRUnit.R fOptions/DESCRIPTION0000644000175100001440000000152712620144160013600 0ustar hornikusersPackage: fOptions Title: Rmetrics - Pricing and Evaluating Basic Options Date: 2015-11-09 Version: 3022.85 Author: Rmetrics Core Team, Diethelm Wuertz [aut], Tobias Setz [cre], Yohan Chalabi [ctb] Maintainer: Tobias Setz Description: Environment for teaching "Financial Engineering and Computational Finance". Pricing and Evaluating Basic Options. Depends: timeDate, timeSeries, fBasics Imports: graphics, methods, stats Suggests: RUnit, tcltk Note: SEVERAL PARTS ARE STILL PRELIMINARY AND MAY BE CHANGED IN THE FUTURE. THIS TYPICALLY INCLUDES FUNCTION AND ARGUMENT NAMES, AS WELL AS DEFAULTS FOR ARGUMENTS AND RETURN VALUES. LazyData: yes License: GPL (>= 2) URL: http://www.rmetrics.org NeedsCompilation: yes Packaged: 2015-11-09 14:49:27 UTC; Tobi Repository: CRAN Date/Publication: 2015-11-09 17:23:12 fOptions/ChangeLog0000644000175100001440000000425112620131167013644 0ustar hornikusers2015-11-09 tsetz * Updated Description and Namespace files * Removed global (e.g. sigma <<- 0.4) assignments. 2013-06-23 chalabi * DESCRIPTION, R/zzz.R, src/Makevars: updated Fortran flags, version number and removed .First.lib() 2012-11-07 chalabi * ChangeLog, DESCRIPTION: Updated ChangeLog and DESC * DESCRIPTION: Updated version number * DESCRIPTION: Updated maintainer field * man/PlainVanillaOptions.Rd: Fixed typo 2012-04-17 chalabi * ChangeLog, DESCRIPTION: update version number and ChangeLog file 2012-04-11 mmaechler * DESCRIPTION, NAMESPACE, R/LowDiscrepancy.R, src/085A-LowDiscrepancy.f: fix array overrun for dimension=1; other cosmetic halton/sobl 2012-03-20 chalabi * DESCRIPTION: updated DESC file 2012-03-19 chalabi * R/HestonNandiOptions.R: fixed partial argument names * src/085A-LowDiscrepancy.f: removed calls to WRITE() in fortranFortran routines * NAMESPACE: added NAMESPACE 2011-09-23 mmaechler * DESCRIPTION: remove deprecated "LazyLoad" entry 2011-06-07 chalabi * ChangeLog, DESCRIPTION: updated ChangeLog and DESC file * src/085A-LowDiscrepancy.f: Delcared all variables and functions to avoid troubles with picky compilers 2011-06-07 mmaechler * src/085A-LowDiscrepancy.f: fix obvious typos after spell-checking 2010-07-23 chalabi * inst/DocCopying.pdf: removed DocCopying.pdf license is already specified in DESCRIPTION file 2010-04-23 chalabi * ChangeLog, DESCRIPTION: updated DESCR and ChangeLog * src/085A-LowDiscrepancy.f: fixed sobol RVS on 64 bit platform * ChangeLog, DESCRIPTION: updated DESC and ChangeLog 2010-04-22 chalabi * src/085A-LowDiscrepancy.f: formating code * src/085A-LowDiscrepancy.f: Updated LowDiscrepancy.f with changes of Christophe Dutang. 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 2009-01-28 chalabi * man/BinomialTreeOptions.Rd, man/MonteCarloOptions.Rd, man/PlainVanillaOptions.Rd: updated manual pages to new Rd parser fOptions/man/0000755000175100001440000000000012620131167012643 5ustar hornikusersfOptions/man/MonteCarloOptions.Rd0000644000175100001440000002457612620131167016567 0ustar hornikusers\name{MonteCarloOptions} \alias{MonteCarloOptions} \alias{wienerMCPath} \alias{plainVanillaMCPayoff} \alias{arithmeticAsianMCPayoff} \alias{MonteCarloOption} \title{Monte Carlo Valuation of Options} \description{ A collection and description of functions to valuate options by Monte Carlo methods. The functions include beside the main Monte Carlo Simulator, example functions to generate Monte Carlo price paths and to compute Monte Carlo price payoffs. \cr The functions are: \tabular{ll}{ \code{sobolInnovations} \tab Example for scrambled Sobol innovations, \cr \code{wienerPath} \tab Example for a Wiener price path, \cr \code{plainVanillaPayoff} \tab Example for the plain vanilla option's payoff, \cr \code{arithmeticAsianPayoff} \tab Example for the arithmetic Asian option's payoff, \cr \code{MonteCarloOption} \tab Monte Carlo Simulator for options. } } \usage{ MonteCarloOption(delta.t, pathLength, mcSteps, mcLoops, init = TRUE, innovations.gen, path.gen, payoff.calc, antithetic = TRUE, standardization = FALSE, trace = TRUE, \dots) } \arguments{ \item{antithetic}{ a logical flag, should antithetic variates be used? By default TRUE. } \item{delta.t}{ the time step interval measured as a fraction of one year, by default one day, i.e. \code{delta.t=1/360}. } \item{init}{ a logical flag, should the random number generator be initialized? By default TRUE. } \item{innovations.gen}{ a user defined function to generate the innovations, this can be the normal random number generator \code{rnorm.pseudo} with mean zero and variance one. For the usage of low discrepancy sequences alternativey \code{rnorm.halton} and \code{rnorm.sobol} can be called. The generator must deliver a normalized matrix of innovations with dimension given by the number of Monte Carlo steps and the path length. The first three arguments of the generator are the the number of Monte Carlo steps \code{mcSteps}, the path length \code{pathLength} and the initialization flag \code{init}. Optional arguments can be passed through the argument \code{\dots}, e.g. the type of scrambling for low discrepancy numbers. } \item{mcLoops, mcSteps}{ the number of Monte Carlo loops and Monte Carlo Steps. In total \code{mcLoops*mcSteps} samples are included in one MC simulation. } \item{path.gen}{ the user defined function to generate the price path. As the only input argument serves the matrix of innovations, the option parameters must be available as global variables. } \item{pathLength}{ the length of the price path. This may be calculated as \code{floor(Time/delta.t)}, where \code{Time} denotes the time to maturation measured in years. } \item{payoff.calc}{ a user defined function to calculate the payoff of the option. As the only input argument serves the path matrix as returned by the path generator. The option parameters must be available as global variables. } \item{standardization}{ a logical flag, should the innovations for one loop be standardized? By default TRUE. } \item{trace}{ a logical flag, should the Monte Carlo simulation be traced? By default TRUE. } \item{\dots}{ additional arguments passed to the innovations generator. } } \value{ \emph{The user defined innovation generator} \cr returns a numeric matrix of (random) innovations to build the Monte Carlo Paths. \cr \emph{The user defined path generator} \cr returns a numeric matrix of the Monte Carlo paths for the calculation of the option's payoffs. To be more precise, as an example the function returns for a Wiener process the matrix \code{(b-sigma*sigma/2)*delta.t + sigma*sqrt(delta.t)*innovations}, where the first term corresponds to the drift and the second to the volatility. \cr \emph{The user defined payoff calculator}, \cr returns the vector of the option's payoffs calculated from the generated paths. As an example this becomes for an arithmetic Asian call option with a Wiener Monte Carlo path \code{payoff = exp(-r*Time)*max(SM-X, 0)} where \code{SM = mean(S*exp(cumsum(path)))} and \code{path} denotes the MC price paths. \cr \bold{MonteCarloOption:} \cr returns a vector with the option prices for each Monte Carlo loop. } \details{ \bold{The Innovations:} \cr\cr The innovations must created by the user defined innovation generator. The Generator has to return a numeric matrix of (random) innovations of size \code{mcSteps} times the \code{pathLength}. The example section shows how to write sa function for scrambled Quasi Monte Carlo Sobol numbers. The package comes with three generators \code{rnorm.pseudo}, \code{rnorm.halton} and \code{rnorm.sobol} which can easily be used for simulations. \cr \bold{The Price Paths:} \cr\cr The user must provide a function which generates the price paths. In the example section the function \code{wienerPath} creates a Wiener Monte Carlo path from random innovations. The Wiener price path requires as input \code{b}, the annualized cost-of-carry rate, and \code{sigma}, the annualized volatility of the underlying security, to compute the drift and variance of the path, these variables must be globally defined. \cr \bold{The Payoff Function:} \cr\cr The user must also provide a function which computes the payoff value of the option. The example sections show how to write payoff calculators for the plain vanilla option and for the arithmetic Asian Option. As the only input argument the path matrix is required. Again, the option parameters must be globally available. \cr \bold{The Monte Carlo Simulator:} \cr\cr The simulator is the heart of the Monte Carlo valuation process. This simulator performs \code{mcLoops} Monte Carlo loops each with \code{mcSteps} Monte Carlo steps. In each loop the following steps are done: first the innovation matrix is created from the specified innovation generator (usually build from the normal pseudo random number or low discrepancy generators), then anththetic innovations are added if desired (by default \code{anththetic=TRUE}), then the innovations can be standardized within each loop (by default \code{standardization=FALSE}), and finally the average payoff of all samples in the loop is computed. The simulation can be traced loop by loop setting the argument \code{trace=TRUE}. } \author{ Diethelm Wuertz for the Rmetrics \R-port. } \references{ Birge J.R. (1994); \emph{Quasi-Monte Carlo Approaches to Option Pricing}, Department of Industrial and Operations Engineering, Technical Report 94--19, University of Michigan. Boyle P. (1977); \emph{Options: A Monte Carlo approach}, Journal of Finance, 32, 323--338. Glasserman P. (2004); \emph{Monte Carlo Methods in Financial Engineering}, Springer-Verlag New York, Inc., 596 pp. Jaeckel P. (2002); \emph{Monte Carlo Methods in Finance}, John Wiley and Sons Ltd, 222 pp. } \examples{ ## How to perform a Monte Carlo Simulation? ## First Step: # Write a function to generate the option's innovations. # Use scrambled normal Sobol numbers: sobolInnovations = function(mcSteps, pathLength, init, ...) { # Create Normal Sobol Innovations: innovations = rnorm.sobol(mcSteps, pathLength, init, ...) # Return Value: innovations } ## Second Step: # Write a function to generate the option's price paths. # Use a Wiener path: wienerPath = function(eps) { # Note, the option parameters must be globally defined! # Generate the Paths: path = (b-sigma*sigma/2)*delta.t + sigma*sqrt(delta.t)*eps # Return Value: path } ## Third Step: # Write a function for the option's payoff # Example 1: use the payoff for a plain Vanilla Call or Put: plainVanillaPayoff = function(path) { # Note, the option parameters must be globally defined! # Compute the Call/Put Payoff Value: ST = S*exp(sum(path)) if (TypeFlag == "c") payoff = exp(-r*Time)*max(ST-X, 0) if (TypeFlag == "p") payoff = exp(-r*Time)*max(0, X-ST) # Return Value: payoff } # Example 2: use the payoff for an arithmetic Asian Call or Put: arithmeticAsianPayoff = function(path) { # Note, the option parameters must be globally defined! # Compute the Call/Put Payoff Value: SM = mean(S*exp(cumsum(path))) if (TypeFlag == "c") payoff = exp(-r*Time)*max(SM-X, 0) if (TypeFlag == "p") payoff = exp(-r*Time)*max(0, X-SM) # Return Value: payoff } ## Final Step: # Set Global Parameters for the plain Vanilla / arithmetic Asian Options: TypeFlag <- "c"; S <- 100; X <- 100 Time <- 1/12; sigma <- 0.4; r <- 0.10; b <- 0.1 # Do the Asian Simulation with scrambled random numbers: mc = MonteCarloOption(delta.t = 1/360, pathLength = 30, mcSteps = 5000, mcLoops = 50, init = TRUE, innovations.gen = sobolInnovations, path.gen = wienerPath, payoff.calc = arithmeticAsianPayoff, antithetic = TRUE, standardization = FALSE, trace = TRUE, scrambling = 2, seed = 4711) # Plot the MC Iteration Path: par(mfrow = c(1, 1)) mcPrice = cumsum(mc)/(1:length(mc)) plot(mcPrice, type = "l", main = "Arithmetic Asian Option", xlab = "Monte Carlo Loops", ylab = "Option Price") # Compare with Turnbull-Wakeman Approximation: # TW = TurnbullWakemanAsianApproxOption(TypeFlag = "c", S = 100, SA = 100, # X = 100, Time = 1/12, time = 1/12, tau = 0 , r = 0.1, b = 0.1, # sigma = 0.4) # print(TW) # abline(h = TW, col = 2) } \keyword{programming} fOptions/man/LowDiscrepancy.Rd0000644000175100001440000001112112620131167016054 0ustar hornikusers\name{LowDiscrepancy} \alias{LowDiscrepancy} \alias{runif.halton} \alias{rnorm.halton} \alias{runif.sobol} \alias{rnorm.sobol} \alias{runif.pseudo} \alias{rnorm.pseudo} \title{Low Discrepancy Sequences} \description{ A collection and description of functions to compute Halton's and Sobol's low discrepancy sequences, distributed in form of a uniform or normal distribution. \cr The functions are: \tabular{ll}{ \code{runif.halton} \tab Uniform Halton sequence, \cr \code{rnorm.halton} \tab Normal Halton sequence, \cr \code{runif.sobol} \tab Uniform scrambled Sobol sequence, \cr \code{rnorm.sobol} \tab Normal scrambled Sobol sequence, \cr \code{runif.pseudo} \tab Uniform pseudo random numbers, \cr \code{norma.pseudo} \tab Normal pseudo random numbers.} } \usage{ runif.halton(n, dimension, init) rnorm.halton(n, dimension, init) runif.sobol(n, dimension, init, scrambling, seed) rnorm.sobol(n, dimension, init, scrambling, seed) runif.pseudo(n, dimension, init) rnorm.pseudo(n, dimension, init) } \arguments{ \item{dimension}{ an integer value, the dimension of the sequence. The maximum value for the Sobol generator is 1111. } \item{init}{ a logical, if TRUE the sequence is initialized and restarts, otherwise not. By default TRUE. } \item{n}{ an integer value, the number of random deviates. } \item{scrambling}{ an integer value, if 1, 2 or 3 the sequence is scrambled otherwise not. If 1, Owen type type of scrambling is applied, if 2, Faure-Tezuka type of scrambling, is applied, and if 3, both Owen+Faure-Tezuka type of scrambling is applied. By default 0. } \item{seed}{ an integer value, the random seed for initialization of the scrambling process. By default 4711. On effective if \code{scrambling>0}. } } \value{ All generators return a numeric matrix of size \code{n} by \code{dimension}. } \details{ \bold{Halton's Low Discrepancy Sequences:} \cr\cr Calculates a matrix of uniform or normal deviated halton low discrepancy numbers. \cr \bold{Scrambled Sobol's Low Discrepancy Sequences:} \cr\cr Calculates a matrix of uniform and normal deviated Sobol low discrepancy numbers. Optional scrambling of the sequence can be selected. \cr \bold{Pseudo Random Number Sequence:} \cr\cr Calculates a matrix of uniform or normal distributed pseudo random numbers. This is a helpful function for comparing investigations obtained from a low discrepancy series with those from a pseudo random number. } \note{ The global variables \code{runif.halton.seed} and \code{runif.sobol.seed} save the status to restart the generators. Note, that only one instance of a generators can be run at the same time. The ACM Algorithm 659 implemented to generate scrambled Sobol sequences is under the License of the ACM restricted for academic and noncommerical usage. Please consult the ACM License agreement included in the \code{doc} directory. } \author{ P. Bratley and B.L. Fox for the Fortran Sobol Algorithm 659,\cr S. Joe for the Fortran extension to 1111 dimensions,\cr Diethelm Wuertz for the Rmetrics \R-port. } \references{ Bratley P., Fox B.L. (1988); \emph{Algorithm 659: Implementing Sobol's Quasirandom Sequence Generator}, ACM Transactions on Mathematical Software 14, 88--100. Joe S., Kuo F.Y. (1998); \emph{Remark on Algorithm 659: Implementing Sobol's Quaisrandom Seqence Generator}. } \examples{ ## *.halton - par(mfrow = c(2, 2), cex = 0.75) runif.halton(n = 10, dimension = 5) hist(runif.halton(n = 5000, dimension = 1), main = "Uniform Halton", xlab = "x", col = "steelblue3", border = "white") rnorm.halton(n = 10, dimension = 5) hist(rnorm.halton(n = 5000, dimension = 1), main = "Normal Halton", xlab = "x", col = "steelblue3", border = "white") ## *.sobol - runif.sobol(n = 10, dimension = 5, scrambling = 3) hist(runif.sobol(5000, 1, scrambling = 2), main = "Uniform Sobol", xlab = "x", col = "steelblue3", border = "white") rnorm.sobol(n = 10, dimension = 5, scrambling = 3) hist(rnorm.sobol(5000, 1, scrambling = 2), main = "Normal Sobol", xlab = "x", col = "steelblue3", border = "white") ## *.pseudo - runif.pseudo(n = 10, dimension = 5) rnorm.pseudo(n = 10, dimension = 5) } \keyword{programming} fOptions/man/PlainVanillaOptions.Rd0000644000175100001440000002766012620131167017073 0ustar hornikusers\name{PlainVanillaOptions} \alias{PlainVanillaOptions} \alias{fOPTION} \alias{fOPTION-class} \alias{GBSOption} \alias{GBSCharacteristics} \alias{BlackScholesOption} \alias{GBSGreeks} \alias{GBSVolatility} \alias{Black76Option} \alias{MiltersenSchwartzOption} \alias{NDF} \alias{CND} \alias{CBND} \alias{print.option} \alias{summary.option} \alias{show,fOPTION-method} \alias{summary.fOPTION} \title{Valuation of Plain Vanilla Options} \description{ A collection and description of functions to valuate plain vanilla options. Included are functions for the Generalized Black-Scholes option pricing model, for options on futures, some utility functions, and print and summary methods for options. \cr The functions are: \tabular{ll}{ \code{GBS*} \tab the generalized Black-Scholes option, \cr \code{BlackScholesOption} \tab a synonyme for the GBSOption, \cr \code{Black76Option} \tab options on Futures, \cr \code{MiltersenSchwartzOption} \tab options on commodity futures, \cr \code{NDF, CND, CBND} \tab distribution functions, \cr \code{print} \tab print method for Options, \cr \code{summary} \tab summary method for Options. } } \usage{ GBSOption(TypeFlag, S, X, Time, r, b, sigma, title = NULL, description = NULL) GBSGreeks(Selection, TypeFlag, S, X, Time, r, b, sigma) GBSCharacteristics(TypeFlag, S, X, Time, r, b, sigma) GBSVolatility(price, TypeFlag, S, X, Time, r, b, tol, maxiter) BlackScholesOption(\dots) Black76Option(TypeFlag, FT, X, Time, r, sigma, title = NULL, description = NULL) MiltersenSchwartzOption(TypeFlag, Pt, FT, X, time, Time, sigmaS, sigmaE, sigmaF, rhoSE, rhoSF, rhoEF, KappaE, KappaF, title = NULL, description = NULL) NDF(x) CND(x) CBND(x1, x2, rho) \S4method{show}{fOPTION}(object) \method{summary}{fOPTION}(object, \dots) \method{print}{option}(x, \dots) \method{summary}{option}(object, \dots) } \arguments{ \item{b}{ the annualized cost-of-carry rate, a numeric value; e.g. 0.1 means 10\% pa. } \item{description}{ a character string which allows for a brief description. } \item{FT}{ [Black76*][MiltersenSchwartz*] - \cr the futures price, a numeric value. } \item{KappaE, KappaF}{ [MiltersenSchwartz*] - \cr the speed of mean reversion of the forward interest rate (E), the speed of mean reversion of the convenience yield (F), a numeric value. } \item{maxiter, tol}{ [GBSVolatility*] - \cr the maximum number of iterations and the tolerance to compute the root of the GBS volatility equation, see \code{uniroot}. } \item{object}{ an object of class \code{"option"}. } \item{price}{ [GBSVolatility*] - \cr the price of the GBS option, a numerical value. } \item{Pt}{ [MiltersenSchwartz*] - \cr the zero coupon bond that expires on the option maturity; a numeric value. } \item{r}{ the annualized rate of interest, a numeric value; e.g. 0.25 means 25\% pa. } \item{rhoSE, rhoSF, rhoEF}{ [MiltersenSchwartz*] - \cr the correlations between the spot commodity price and the future convenience yield (SE), between the spot commodity price and the forward interest rate (SF), between the forward interest rate and the future convenience yield (EF), a numeric value. } \item{S}{ the asset price, a numeric value. } \item{Selection}{ [GBSGreeks] - \cr sensitivity to be computed, one of \code{"delta"}, \code{"gamma"}, \code{"vega"}, \code{"theta"}, \code{"rho"}, or \code{"CoC"}, a string value. } \item{sigma}{ the annualized volatility of the underlying security, a numeric value; e.g. 0.3 means 30\% volatility pa. } \item{sigmaS, sigmaE, sigmaF}{ [MiltersenSchwartz*] - \cr numeric values, the annualized volatility of the spot commodity price (S), of the future convenience yield (E), and of the forward interest rate (F), e.g. 0.25 means 25\% pa. } \item{time, Time}{ the time to maturity measured in years, a numeric value. } \item{title}{ a character string which allows for a project title. } \item{TypeFlag}{ a character string either \code{"c"} for a call option or a \code{"p"} for a put option. } \item{x, x1, x2, rho}{ [NDF][CND][CBND] - \cr the function argument \code{x} for the normal distribution function \code{NDF} and the cumulated normal distribution \code{CND}. The arguments for the bivariate function are named \code{x1} and \code{x2}; \code{rho} is the correlation coefficient. \cr [print] - \cr the object \code{x} to be printed. } \item{X}{ a numeric value, the exercise price. } \item{\dots}{ arguments to be passed. } } \value{ \code{GBSOption}\cr \code{BlackScholesOption} \cr returns an object of class \code{"fOption"}. \cr \code{GBSGreeks} \cr returns the option sensitivity for the selected Greek, a numeric value. \cr \code{GBSCharacteristics} \cr returns a list with the following entries: \code{premium}, the option price, \code{delta}, the delta sensitivity, \code{gamma}, the gamma sensitivity, \code{theta}, the theta sensitivity, \code{vega}, the vega sensitivity, \code{rho}, the rho sensitivity, \code{lambda}, the lambda sensitivity. \cr \code{GBSVolatility} \cr returns the GBS option implied volatility for a given price. \cr \code{Black76Option},\cr \code{MiltersenSchwartzOption} \cr return an object of class \code{"fOption"}. The option valuation programs return an object of class \code{"fOPTION"} with the following slots: \item{@call}{ the function call. } \item{@parameters}{ a list with the input parameters. } \item{@price}{ a numeric value with the value of the option. } \item{@title}{ a character string with the name of the test. } \item{@description}{ a character string with a brief description of the test. } } \details{ \bold{Generalized Black Scholes Options:} \cr\cr \code{GBSOption} calculates the option price, \code{GBSGreeks} calculates option sensitivities delta, theta, vega, rho, lambda and gamma, and \code{GBScharacterisitics} does both. \code{GBSVolatility} computes the implied volatility. \cr Note, that setting \code{b = r} we get Black and Scholes' stock option model, \code{b = r-q} we get Merton's stock option model with continuous dividend yield \code{q}, \code{b = 0} we get Black's futures option model, and \code{b = r-rf} we get Garman and Kohlhagen's currency option model with foreign interest rate \code{rf}. \cr \bold{Options on Futures:} \cr\cr The \code{Black76Option} pricing formula is applicable for valuing European call and European put options on commodity futures. The exact nature of the underlying commodity varies and may be anything from a precious metal such as gold or silver to agricultural products. \cr The \code{Miltersen Schwartz Option} model is a three factor model with stochastic futures prices, term structures and convenience yields, and interest rates. The model is based on lognormal distributed commodity prices and normal distributed continuously compounded forward interest rates and future convenience yields. \cr \bold{Miltersen Schwartz Options:} \cr\cr The \code{MiltersenSchwartzOption} function allows for pricing options on commodity futures. The model is a three factor model with stochastic futures prices, term structures of convenience yields, and interest rates. The model is based on lognormal distributed commodity prices and normal distributed continuously compounded forward interest rates and futures convenience yields. \cr \bold{Distribution Functions:} \cr\cr The functions \code{NDF}, \code{CND}, and \code{CBND} compute vlues for the Normal density functions, for the normal probability function, and for the bivariate normal probability functions. The functions are implemented as described in the book of E.G. Haug. \cr \bold{Print and Summary Method:} \cr\cr Thes are two methods to print and sumarize an object of class \code{"fOPTION"} or of \code{"option"}. The second is used for the older class representation. } \note{ The functions implement algorithms to valuate plain vanilla options and to compute option Greeks as described in Chapter 1 of Haug's Option Guide (1997). } \references{ Black F., Scholes M. (1973); \emph{The Pricing of Options and Corporate Liabilities}, Journal of Political Economy 81, 637--654. Haug E.G. (1997); \emph{The Complete Guide to Option Pricing Formulas}, Chapter 1, McGraw-Hill, New York. Hull J.C. (1998); \emph{Introduction to Futures and Options Markets}, Prentice Hall, London. Miltersen K., Schwartz E.S. (1998); \emph{Pricing of Options on Commodity Futures with Stochastic Term Structuures of Convenience Yields and Interest Rates}, Journal of Financial and Quantitative Analysis 33, 33--59. } \author{ Diethelm Wuertz for the Rmetrics \R-port. } \examples{ ## All the examples are from Haug's Option Guide (1997) ## CHAPTER 1.1: ANALYTICAL FORMULAS FOR EUROPEAN OPTIONS: ## Black Scholes Option [Haug 1.1.1] GBSOption(TypeFlag = "c", S = 60, X = 65, Time = 1/4, r = 0.08, b = 0.08, sigma = 0.30) ## European Option on a Stock with Cash Dividends [Haug 1.1.2] S0 = 100; r = 0.10; D1 = D2 = 2; t1 = 1/4; t2 = 1/2 S = S0 - 2*exp(-r*t1) - 2*exp(-r*t2) GBSOption(TypeFlag = "c", S = S, X = 90, Time = 3/4, r = r, b = r, sigma = 0.25) ## Options on Stock Indexes [Haug 1.2.3] GBSOption(TypeFlag = "p", S = 100, X = 95, Time = 1/2, r = 0.10, b = 0.10-0.05, sigma = 0.20) ## Option on Futures [Haug 1.1.4] FuturesPrice = 19 GBSOption(TypeFlag = "c", S = FuturesPrice, X = 19, Time = 3/4, r = 0.10, b = 0, sigma = 0.28) ## Currency Option [Haug 1.1.5] r = 0.06; rf = 0.08 GBSOption(TypeFlag = "c", S = 1.5600, X = 1.6000, Time = 1/2, r = 0.06, b = 0.06-0.08, sigma = 0.12) ## Delta of GBS Option [Haug 1.3.1] GBSGreeks(Selection = "delta", TypeFlag = "c", S = 105, X = 100, Time = 1/2, r = 0.10, b = 0, sigma = 0.36) ## Gamma of GBS Option [Haug 1.3.3] GBSGreeks(Selection = "gamma", TypeFlag = "c", S = 55, X = 60, Time = 0.75, r = 0.10, b = 0.10, sigma = 0.30) ## Vega of GBS Option [Haug 1.3.4] GBSGreeks(Selection = "vega", TypeFlag = "c", S = 55, X = 60, Time = 0.75, r = 0.10, b = 0.10, sigma = 0.30) ## Theta of GBS Option [Haug 1.3.5] GBSGreeks(Selection = "theta", TypeFlag = "p", S = 430, X = 405, Time = 0.0833, r = 0.07, b = 0.07-0.05, sigma = 0.20) ## Rho of GBS Option [Haug 1.3.5] GBSGreeks(Selection = "rho", TypeFlag = "c", S = 72, X = 75, Time = 1, r = 0.09, b = 0.09, sigma = 0.19) ## CHAPTER 1.3 OPTIONS SENSITIVITIES: ## The Generalized Black Scholes Option Formula GBSCharacteristics(TypeFlag = "p", S = 1.5600, X = 1.6000, Time = 1, r = 0.09, b = 0.09, sigma = 0.19) ## CHAPTER 1.5: RECENT DEVELOPMENTS IN COMMODITY OPTIONS ## Miltersen Schwartz Option vs. Black76 Option on Futures: MiltersenSchwartzOption(TypeFlag = "c", Pt = exp(-0.05/4), FT = 95, X = 80, time = 1/4, Time = 1/2, sigmaS = 0.2660, sigmaE = 0.2490, sigmaF = 0.0096, rhoSE = 0.805, rhoSF = 0.0805, rhoEF = 0.1243, KappaE = 1.045, KappaF = 0.200) Black76Option(TypeFlag = "c", FT = 95, X = 80, Time = 1/2, r = 0.05, sigma = 0.266) } \keyword{math} fOptions/man/HestonNandiGarchFit.Rd0000644000175100001440000001630112620131167016755 0ustar hornikusers\name{HestonNandiGarchFit} \alias{HestonNandiGarchFit} \alias{hngarchSim} \alias{hngarchFit} \alias{hngarchStats} \alias{print.hngarch} \alias{summary.hngarch} \title{Heston-Nandi Garch(1,1) Modelling} \description{ A collection and description of functions to model the GARCH(1,1) price paths which underly Heston and Nandi's option pricing model. \cr The functions are: \tabular{ll}{ \code{hngarchSim} \tab Simulates a Heston-Nandi Garch(1,1) process, \cr \code{hngarchFit} \tab MLE for a Heston Nandi Garch(1,1) model, \cr \code{hngarchStats} \tab True moments of the log-Return distribution, \cr \code{print.hngarch} \tab Print method, \cr \code{summary.hngarch} \tab Diagnostic summary.} } \usage{ hngarchSim(model, n, innov, n.start, start.innov, rand.gen, \dots) hngarchFit(x, model = list(lambda = -0.5, omega = var(x), alpha = 0.1 * var(x), beta = 0.1, gamma = 0, rf = 0), symmetric = TRUE, trace = FALSE, title = NULL, description = NULL, \dots) hngarchStats(model) \method{print}{hngarch}(x, \dots) \method{summary}{hngarch}(object, \dots) } \arguments{ \item{description}{ a brief description of the porject of type character. } \item{innov}{ [hngarchSim] - \cr is a univariate time series or vector of innovations to produce the series. If not provided, \code{innov} will be generated using the random number generator specified by \code{rand.gen}. Missing values are not allowed. By default the normal random number generator will be used. } \item{model}{ a list of GARCH model parameters with the following entries: \code{lambda}, \code{omega}, the constant coefficient of the variance equation, \code{alpha} the autoregressive coefficient, \code{beta} the variance coefficient, \code{gamma} the asymmetry coefficient, and \code{rf}, the risk free rate, numeric values. } \item{n}{ [hngarchSim] - \cr is the length of the series to be simulated. The default value is 1000. } \item{n.start}{ [hngarchSim] - \cr gives the number of start-up values to be discarded. The default value is 100. } \item{object}{ [summary] - \cr a fitted HN-GARCH(1,1) time series object of class \code{"hngarch"} as returned from the function \code{hngarchFit}. } \item{rand.gen}{ [hngarchSim] - \cr is the function which is called to generate the innovations. Usually, \code{rand.gen} will be a random number generator. Additional arguments required by the random number generator \code{rand.gen}, usually the location, scale and/or shape parameter of the underlying distribution function, have to be passed through the \code{dots} argument. } \item{start.innov}{ [hngarchSim] - \cr is a univariate time series or vector of innovations to be used as start up values. Missing values are not allowed. } \item{symmetric}{ [hngarchFit] - \cr a logical, if TRUE a symmetric model is estimated, otherwise the parameters are estimated for an asymmetric HN Garch(1,1) model. } \item{title}{ a character string which allows for a project title. } \item{trace}{ [hngarchFit] - \cr a logical value. Should the optimizarion be traced? If \code{trace=FALSE}, no tracing is done of the iteration path. } \item{x}{ [hngarchFit] - \cr an univariate vector or time series. \cr [print] - \cr a fitted HN-GARCH(1,1) time series object of class \code{"hngarch"} as returned from the function \code{hngarchFit}. } \item{\dots}{ additional arguments to be passed. } } \details{ \bold{Path Simulation:} \cr\cr The function \code{hngarchSim} simulates a Heston-Nandi Garch(1,1) process with structure parameters specified through the list \code{model(lambda, omega, alpha, beta, gamma, rf)}. \cr \bold{Parameter Estimation:} \cr\cr The function \code{hngarchFit} estimates by the maximum log-likelihood approach the parameters either for a symmetric or an asymmetric Heston-Nandi Garch(1,1) model from the log returns \code{x} of a financial time series. For optimization R's \code{optim} function is used. Additional optimization parameters may be passed throught the \code{\dots} argument. \cr \bold{Diagnostic Analysis:} \cr\cr The function \code{summary.hngarch} performs a diagnostic analysis and recalculates conditional variances and innovations from the time series. \cr \bold{Calculation of Moments:} \cr\cr The function \code{hngarchStats} calculates the first four true moments of the unconditional log return distribution for a stationary Heston-Nandi Garch(1,1) process with standard normally distributed innovations. In addition the persistence and the expectation values of sigma to the power 2, 4, 6, and 8 can be accessed. } \value{ \code{hngarchSim} \cr returns numeric vector with the simulated time series points neglecting those from the first \code{start.innov} innovations. \cr \code{hngarchFit} \cr returns list with two entries: The estimated model parmeters \code{model}, where \code{model} is a list of the parameters itself, and \code{llh} the value of the log likelihood. \cr \code{hngarchStats} \cr returns a list with the following components: \code{persistence}, the value of the persistence, \code{meansigma2}, \code{meansigma4}, \code{meansigma6}, \code{meansigma8}, the expectation value of sigma to the power of 2, 4, 6, and 8, \code{mean}, \code{variance}, \code{skewness}, \code{kurtosis}, the mean, variance, skewness and kurtosis of the log returns. \cr \code{summary.hngarch} \cr returns list with the following elements: \code{h}, a numeric vector with the conditional variances, \code{z}, a numeric vector with the innovations. } \references{ Heston S.L., Nandi S. (1997); \emph{A Closed-Form GARCH Option Pricing Model}, Federal Reserve Bank of Atlanta. } \author{ Diethelm Wuertz for the Rmetrics \R-port. } \examples{ ## hngarchSim - # Simulate a Heston Nandi Garch(1,1) Process: # Symmetric Model - Parameters: model = list(lambda = 4, omega = 8e-5, alpha = 6e-5, beta = 0.7, gamma = 0, rf = 0) ts = hngarchSim(model = model, n = 500, n.start = 100) par(mfrow = c(2, 1), cex = 0.75) ts.plot(ts, col = "steelblue", main = "HN Garch Symmetric Model") grid() ## hngarchFit - # HN-GARCH log likelihood Parameter Estimation: # To speed up, we start with the simulated model ... mle = hngarchFit(model = model, x = ts, symmetric = TRUE) mle ## summary.hngarch - # HN-GARCH Diagnostic Analysis: par(mfrow = c(3, 1), cex = 0.75) summary(mle) ## hngarchStats - # HN-GARCH Moments: hngarchStats(mle$model) } \keyword{models} fOptions/man/HestonNandiOptions.Rd0000644000175100001440000001067312620131167016727 0ustar hornikusers\name{HestonNandiOptions} \alias{HestonNandiOptions} \alias{HNGOption} \alias{HNGGreeks} \alias{HNGCharacteristics} \title{Option Price for the Heston-Nandi Garch Option Model} \description{ A collection and description of functions to valuate Heston-Nandi options. Included are functions to compute the option price and the delta and gamma sensitivities for call and put options. \cr The functions are: \tabular{ll}{ \code{HNGOption} \tab Heston-Nandi GARCH(1,1) option price, \cr \code{HNGGreeks} \tab Heston-Nandi GARCH(1,1) option sensitivities, \cr \code{HNGCharacteristics} \tab option prices and sensitivities. } } \usage{ HNGOption(TypeFlag, model, S, X, Time.inDays, r.daily) HNGGreeks(Selection, TypeFlag, model, S, X, Time.inDays, r.daily) HNGCharacteristics(TypeFlag, model, S, X, Time.inDays, r.daily) } \arguments{ \item{model}{ a list of model parameters with the following entries: \code{lambda}, \code{omega}, \code{alpha}, \code{beta}, and \code{gamma}, numeric values. } \item{r.daily}{ the daily rate of interest, a numeric value; e.g. 0.25/252 means about 0.001\% per day. } \item{S}{ the asset price, a numeric value. } \item{Selection}{ sensitivity to be computed, one of \code{"delta"}, \code{"gamma"}, \code{"vega"}, \code{"theta"}, \code{"rho"}, or \code{"CoC"}, a string value. } \item{Time.inDays}{ the time to maturity measured in days, a numerical value; e.g. 5/252 means 1 business week. } \item{TypeFlag}{ a character string either \code{"c"} for a call option or a \code{"p"} for a put option. } \item{X}{ the exercise price, a numeric value. } } \value{ \code{HNGOption} \cr returns a list object of class \code{"option"} with \code{$price} denoting the option price, a numeric value, and \code{$call} a character string which matches the function call. \cr \code{HNGOGreeks} \cr returns the option sensitivity for the selected Greek, either \code{"delta"} or \code{"gamma"}; a numeric value. \code{HNGCharacteristics} \cr returns a list with the following entries: \item{premium}{ the option price, a numeric value.} \item{delta}{ the delta sensitivity, a numeric value.} \item{gamma}{ the gamma sensitivity, a numeric value.} } \details{ \bold{Option Values:} \cr\cr \code{HNGOption}calculates the option price, \code{HNGGreeks} allows to compute the option sensitivity Delta or Gamma, and \code{HNGcharacterisitics} summarizes both in one function call. } \references{ Heston S.L., Nandi S. (1997); \emph{A Closed-Form GARCH Option Pricing Model}, Federal Reserve Bank of Atlanta. } \author{ Diethelm Wuertz for the Rmetrics \R-port. } \examples{ ## model - # Define the Model Parameters for a Heston-Nandi Option: model = list(lambda = -0.5, omega = 2.3e-6, alpha = 2.9e-6, beta = 0.85, gamma = 184.25) S = X = 100 Time.inDays = 252 r.daily = 0.05/Time.inDays sigma.daily = sqrt((model$omega + model$alpha) / (1 - model$beta - model$alpha * model$gamma^2)) data.frame(S, X, r.daily, sigma.daily) ## HNGOption - # Compute HNG Call-Put and compare with GBS Call-Put: HNG = GBS = Diff = NULL for (TypeFlag in c("c", "p")) { HNG = c(HNG, HNGOption(TypeFlag, model = model, S = S, X = X, Time.inDays = Time.inDays, r.daily = r.daily)$price ) GBS = c(GBS, GBSOption(TypeFlag, S = S, X = X, Time = Time.inDays, r = r.daily, b = r.daily, sigma = sigma.daily)@price) } Options = cbind(HNG, GBS, Diff = round(100*(HNG-GBS)/GBS, digits=2)) row.names(Options) <- c("Call", "Put") data.frame(Options) ## HNGGreeks - # Compute HNG Greeks and compare with GBS Greeks: Selection = c("Delta", "Gamma") HNG = GBS = NULL for (i in 1:2){ HNG = c(HNG, HNGGreeks(Selection[i], TypeFlag = "c", model = model, S = 100, X = 100, Time = Time.inDays, r = r.daily) ) GBS = c(GBS, GBSGreeks(Selection[i], TypeFlag = "c", S = 100, X = 100, Time = Time.inDays, r = r.daily, b = r.daily, sigma = sigma.daily) ) } Greeks = cbind(HNG, GBS, Diff = round(100*(HNG-GBS)/GBS, digits = 2)) row.names(Greeks) <- Selection data.frame(Greeks) } \keyword{math} fOptions/man/BasicAmericanOptions.Rd0000644000175100001440000001252512620131167017174 0ustar hornikusers\name{BasicAmericanOptions} \alias{BasicAmericanOptions} \alias{RollGeskeWhaleyOption} \alias{BAWAmericanApproxOption} \alias{BSAmericanApproxOption} \title{Valuation of Basic American Options} \description{ A collection and description of functions to valuate basic American options. Approximative formulas for American calls are given for the Roll, Geske and Whaley Approximation, for the Barone-Adesi and Whaley Approximation, and for the Bjerksund and Stensland Approximation. \cr The functions are: \tabular{ll}{ \code{RollGeskeWhaleyOption} \tab Roll, Geske and Whaley Approximation, \cr \code{BAWAmericanApproxOption} \tab Barone-Adesi and Whaley Approximation, \cr \code{BSAmericanApproxOption} \tab Bjerksund and Stensland Approximation. } } \usage{ RollGeskeWhaleyOption(S, X, time1, Time2, r, D, sigma, title = NULL, description = NULL) BAWAmericanApproxOption(TypeFlag, S, X, Time, r, b, sigma, title = NULL, description = NULL) BSAmericanApproxOption(TypeFlag, S, X, Time, r, b, sigma, title = NULL, description = NULL) } \arguments{ \item{b}{ the annualized cost-of-carry rate, a numeric value; e.g. 0.1 means 10\% pa. } \item{D}{ a single dividend with time to dividend payout \code{t1}. } \item{description}{ a character string which allows for a brief description. } \item{r}{ the annualized rate of interest, a numeric value; e.g. 0.25 means 25\% pa. } \item{S}{ the asset price, a numeric value. } \item{sigma}{ the annualized volatility of the underlying security, a numeric value; e.g. 0.3 means 30\% volatility pa. } \item{Time}{ the time to maturity measured in years, a numeric value. } \item{time1, Time2}{ [RollGeskeWhaley*] - the first value measures time to dividend payout in years, e.g. 0.25 denotes a quarter, and the second value measures time to maturity measured in years, a numeric value; e.g. 0.5 means 6 months. } \item{title}{ a character string which allows for a project title. } \item{TypeFlag}{ a character string either "c" for a call option or a "p" for a put option. } \item{X}{ the exercise price, a numeric value. } } \value{ \code{RollGeskeWhaleyOption} \cr \code{BAWAmericanApproxOption} \cr return the option price, a numeric value. \cr \code{BSAmericanApproxOption} \cr returns a list with the following two elements: \code{Premium} the option price, and \code{TriggerPrice} the trigger price. \cr } \details{ \bold{Roll-Geske-Whaley Option:} \cr\cr The function \code{RollGeskeWhaleyOption} valuates American calls on a stock paying a single dividend with specified time to dividend payout according to the pricing formula derived by Roll, Geske and Whaley (1977). \cr \code{Approximations for American Options:} \cr\cr The function \code{BSAmericanApproxOption} valuates American calls or puts on an underlying asset for a given cost-of-carry rate according to the quadratic approximation method due to Barone-Adesi and Whaley (1987). The function \code{BSAmericanApproxOption} valuates American calls or puts on stocks, futures, and currencies due to the approximation method of Bjerksund and Stensland (1993). } \note{ The functions implement the algorithms to valuate basic American options as described in Chapter 1.4 of Haug's Option Guide (1997). } \references{ Barone-Adesi G., Whaley R.E. (1987); \emph{Efficient Analytic Approximation of American Option Values}, Journal of Finance 42, 301--320. Bjerksund P., Stensland G. (1993); \emph{Closed Form Approximation of American Options}, Scandinavian Journal of Management 9, 87--99. Geske R. (1979); \emph{A Note on an Analytical Formula for Unprotected American Call Options on Stocks with known Dividends}, Journal of Financial Economics 7, 63--81. Haug E.G. (1997); \emph{The Complete Guide to Option Pricing Formulas}, Chapter 1, McGraw-Hill, New York. Roll R. (1977); \emph{An Analytic Valuation Formula for Unprotected American Call Options on Stocks with known Dividends}, Journal of Financial Economics 5, 251--258. } \author{ Diethelm Wuertz for the Rmetrics \R-port. } \examples{ ## All the examples are from Haug's Option Guide (1997) ## CHAPTER 1.4: ANALYTICAL MODELS FOR AMERICAN OPTIONS ## Roll-Geske-Whaley American Calls on Dividend Paying # Stocks [Haug 1.4.1] RollGeskeWhaleyOption(S = 80, X = 82, time1 = 1/4, Time2 = 1/3, r = 0.06, D = 4, sigma = 0.30) ## Barone-Adesi and Whaley Approximation for American # Options [Haug 1.4.2] vs. Black76 Option on Futures: BAWAmericanApproxOption(TypeFlag = "p", S = 100, X = 100, Time = 0.5, r = 0.10, b = 0, sigma = 0.25) Black76Option(TypeFlag = "c", FT = 100, X = 100, Time = 0.5, r = 0.10, sigma = 0.25) ## Bjerksund and Stensland Approximation for American Options: BSAmericanApproxOption(TypeFlag = "c", S = 42, X = 40, Time = 0.75, r = 0.04, b = 0.04-0.08, sigma = 0.35) } \keyword{math} fOptions/man/BinomialTreeOptions.Rd0000644000175100001440000001735512620131167017073 0ustar hornikusers\name{BinomialTreeOptions} \alias{BinomialTreeOptions} \alias{CRRBinomialTreeOption} \alias{JRBinomialTreeOption} \alias{TIANBinomialTreeOption} \alias{BinomialTreeOption} \alias{BinomialTreePlot} \title{Binomial Tree Option Model} \description{ A collection and description of functions to valuate options in the framework of the Binomial tree option approach. \cr The functions are: \tabular{ll}{ \code{CRRBinomialTreeOption} \tab CRR Binomial Tree Option, \cr \code{JRBinomialTreeOption} \tab JR Binomial Tree Option, \cr \code{TIANBinomialTreeOption} \tab TIAN Binomial Tree Option, \cr \code{BinomialTreeOption} \tab Binomial Tree Option, \cr \code{BinomialTreePlot} \tab Binomial Tree Plot. } } \usage{ CRRBinomialTreeOption(TypeFlag = c("ce", "pe", "ca", "pa"), S, X, Time, r, b, sigma, n, title = NULL, description = NULL) JRBinomialTreeOption(TypeFlag = c("ce", "pe", "ca", "pa"), S, X, Time, r, b, sigma, n, title = NULL, description = NULL) TIANBinomialTreeOption(TypeFlag = c("ce", "pe", "ca", "pa"), S, X, Time, r, b, sigma, n, title = NULL, description = NULL) BinomialTreeOption(TypeFlag = c("ce", "pe", "ca", "pa"), S, X, Time, r, b, sigma, n, title = NULL, description = NULL) BinomialTreePlot(BinomialTreeValues, dx = -0.025, dy = 0.4, cex = 1, digits = 2, \dots) } \arguments{ \item{b}{ the annualized cost-of-carry rate, a numeric value; e.g. 0.1 means 10\% pa. } \item{BinomialTreeValues}{ the return value from the \code{BinomialTreeOption} function. } \item{cex}{ a numerical value giving the amount by which the plotting text and symbols should be scaled relative to the default. } \item{description}{ a character string which allows for a brief description. } \item{digits}{ an integer value, how many digits should be displayed in the option tree? } \item{dx, dy}{ numerical values, an offset fine tuning for the placement of the option values in the option tree. } \item{n}{ number of time steps; an integer value. } \item{r}{ the annualized rate of interest, a numeric value; e.g. 0.25 means 25\% pa. } \item{S}{ the asset price, a numeric value. } \item{sigma}{ the annualized volatility of the underlying security, a numeric value; e.g. 0.3 means 30\% volatility pa. } \item{Time}{ the time to maturity measured in years, a numeric value; e.g. 0.5 means 6 months. } \item{title}{ a character string which allows for a project title. } \item{TypeFlag}{ a character string either \code{"ce"}, \code{"ca"} for an European or American call option or a \code{"pe"}, \code{"pa"} for a put option, respectively. } \item{X}{ the exercise price, a numeric value. } \item{\dots}{ arguments to be passed. } } \details{ \bold{CRR Binomial Tree Model:} \cr\cr Binomial models were first suggested by Cox, Ross and Rubinstein (1979), CRR, and then became widely used because of its intuition and easy implementation. Binomial trees are constructed on a discrete-time lattice. With the time between two trading events shrinking to zero, the evolution of the price converges weakly to a lognormal diffusion. Within this mode the European options value converges to the value given by the Black-Scholes formula. \cr \bold{JR Binomial Tree Model:} \cr\cr There exist many extensions of the CRR model. Jarrow and Rudd (1983), JR, adjusted the CRR model to account for the local drift term. They constructed a binomial model where the first two moments of the discrete and continuous time return processes match. As a consequence a probability measure equal to one half results. Therefore the CRR and JR models are sometimes atrributed as equal jumps binomial trees and equal probabilities binomial trees. \cr \bold{TIAN Binomial Tree Model:} \cr\cr Tian (1993) suggested to match discrete and continuous local moments up to third order. Leisen and Reimer (1996) proved that the order of convergence in pricing European options for all three methods is equal to one, and thus the three models are equivalent. } \note{ Note, the \code{BinomialTree} and \code{BinomialTreePlot} are preliminary implementations. } \value{ The option price, a numeric value. } \references{ Broadie M., Detemple J. (1994); \emph{American Option Evaluation: New Bounds, Approximations, and a Comparison of Existing Methods}, Working Paper, Columbia University, New York. Cox J., Ross S.A., Rubinstein M. (1979); \emph{Option Pricing: A Simplified Approach}, Journal of Financial Economics 7, 229--263. Haug E.G. (1997); \emph{The complete Guide to Option Pricing Formulas}, McGraw-Hill, New York. Hull J.C. (1998); \emph{Introduction to Futures and Options Markets}, Prentice Hall, London. Jarrow R., Rudd A. (1983); \emph{Option Pricing}, Homewood, Illinois, 183--188. Leisen D.P., Reimer M., (1996); \emph{Binomial Models for Option Valuation -- Examining and Improving Convergence}, Applied Mathematical Finanace 3, 319--346. Tian Y. (1993); \emph{A Modified Lattice Approach to Option Pricing}, Journal of Futures Markets 13, 563--577. } \author{ Diethelm Wuertz for the Rmetrics \R-port. } \examples{ ## Cox-Ross-Rubinstein Binomial Tree Option Model: # Example 14.1 from Hull's Book: CRRBinomialTreeOption(TypeFlag = "pa", S = 50, X = 50, Time = 5/12, r = 0.1, b = 0.1, sigma = 0.4, n = 5) # Example 3.1.1 from Haug's Book: CRRBinomialTreeOption(TypeFlag = "pa", S = 100, X = 95, Time = 0.5, r = 0.08, b = 0.08, sigma = 0.3, n = 5) # A European Call - Compare with Black Scholes: CRRBinomialTreeOption(TypeFlag = "ce", S = 100, X = 100, Time = 1, r = 0.1, b = 0.1, sigma = 0.25, n = 50) GBSOption(TypeFlag = "c", S = 100, X = 100, Time = 1, r = 0.1, b = 0.1, sigma = 0.25)@price ## CRR - JR - TIAN Model Comparison: # Hull's Example as Function of "n": par(mfrow = c(2, 1), cex = 0.7) steps = 50 CRROptionValue = JROptionValue = TIANOptionValue = rep(NA, times = steps) for (n in 3:steps) { CRROptionValue[n] = CRRBinomialTreeOption(TypeFlag = "pa", S = 50, X = 50, Time = 0.4167, r = 0.1, b = 0.1, sigma = 0.4, n = n)@price JROptionValue[n] = JRBinomialTreeOption(TypeFlag = "pa", S = 50, X = 50, Time = 0.4167, r = 0.1, b = 0.1, sigma = 0.4, n = n)@price TIANOptionValue[n] = TIANBinomialTreeOption(TypeFlag = "pa", S = 50, X = 50, Time = 0.4167, r = 0.1, b = 0.1, sigma = 0.4, n = n)@price } plot(CRROptionValue[3:steps], type = "l", col = "red", ylab = "Option Value") lines(JROptionValue[3:steps], col = "green") lines(TIANOptionValue[3:steps], col = "blue") # Add Result from BAW Approximation: BAWValue = BAWAmericanApproxOption(TypeFlag = "p", S = 50, X = 50, Time = 0.4167, r = 0.1, b = 0.1, sigma = 0.4)@price abline(h = BAWValue, lty = 3) title(main = "Convergence") data.frame(CRROptionValue, JROptionValue, TIANOptionValue) ## Plot CRR Option Tree: # Again Hull's Example: CRRTree = BinomialTreeOption(TypeFlag = "pa", S = 50, X = 50, Time = 0.4167, r = 0.1, b = 0.1, sigma = 0.4, n = 5) BinomialTreePlot(CRRTree, dy = 1, cex = 0.8, ylim = c(-6, 7), xlab = "n", ylab = "Option Value") title(main = "Option Tree") } \keyword{math} fOptions/man/00fOptions-package.Rd0000644000175100001440000001100312620131167016457 0ustar hornikusers\name{fOptions-package} \alias{fOptions-package} \alias{fOptions} \docType{package} \title{Basic Option Valuation} \description{ The Rmetrics "Options" package is a collection of functions to valuate basic pptions. } \details{ \tabular{ll}{ Package: \tab fOptions\cr Type: \tab Package\cr Version: \tab R 3.0.1\cr Date: \tab 2014\cr License: \tab GPL Version 2 or later\cr Copyright: \tab (c) 1999-2014 Rmetrics Assiciation\cr URL: \tab \url{https://www.rmetrics.org} } } \section{1 Introduction}{ The \code{fOptions} package provides function for pricing and evaluationg basic options. } \section{2 Plain Vanilla Option}{ This section provides a collection of functions to valuate plain vanilla options. Included are functions for the Generalized Black-Scholes option pricing model, for options on futures, some utility functions, and print and summary methods for options. \preformatted{ GBS* the generalized Black-Scholes option BlackScholesOption a synonyme for the GBSOption Black76Option options on Futures MiltersenSchwartzOption options on commodity futures } \preformatted{ NDF, CND, CBND distribution functions } \preformatted{ print print method for Options summary summary method for Options } } \section{3 Binomial Tree Options}{ This section offers a collection of functions to valuate options in the framework of the Binomial tree option approach. \preformatted{ CRRBinomialTreeOption CRR Binomial Tree Option JRBinomialTreeOption JR Binomial Tree Option TIANBinomialTreeOption TIAN Binomial Tree Option BinomialTreeOption Binomial Tree Option BinomialTreePlot Binomial Tree Plot } } \section{4 Monte Carlo Options}{ In this section we provide functions to valuate options by Monte Carlo methods. The functions include beside the main Monte Carlo Simulator, example functions to generate Monte Carlo price paths and to compute Monte Carlo price payoffs. \preformatted{ sobolInnovations Example for scrambled Sobol innovations wienerPath Example for a Wiener price path plainVanillaPayoff Example for the plain vanilla option's payoff arithmeticAsianPayoff Example for the arithmetic Asian option's payoff MonteCarloOption Monte Carlo Simulator for options } } \section{5 Low Discrepancy Sequences}{ This section provides three types of random number generators for univorm and normal distributed deviates. These area pseudo random number generator and a halton and sobol generator for low discrepancy sequences. \preformatted{ runif.pseudo Uniform pseudo random numbers rnorm.pseudo Normal pseudo random numbers } \preformatted{ runif.halton Uniform Halton sequence rnorm.halton Normal Halton sequence } \preformatted{ runif.sobol Uniform scrambled Sobol sequence rnorm.sobol Normal scrambled Sobol sequence }r } \section{6 Heston Nandi Garch Fit}{ Her we provide functions to model the GARCH(1,1) price paths which underly Heston and Nandi's option pricing model. The functions are: \preformatted{ hngarchSim simulates a Heston-Nandi Garch(1,1) process hngarchFit fits parameters of a Heston Nandi Garch(1,1) model } \preformatted{ hngarchStats returns true moments of the log-Return distribution } \preformatted{ print.hngarch print method, \cr summary.hngarch diagnostic summary } } \section{7 Heston Nandi Garch Options}{ This section comes with functions to valuate Heston-Nandi options. Provided are functions to compute the option price and the delta and gamma sensitivities for call and put options. \preformatted{ HNGOption Heston-Nandi GARCH(1,1) option price HNGGreeks Heston-Nandi GARCH(1,1) option sensitivities HNGCharacteristics combines option prices and sensitivities } } \section{About Rmetrics}{ The \code{fOptions} Rmetrics package is written for educational support in teaching "Computational Finance and Financial Engineering" and licensed under the GPL. } \keyword{package}