tests/testthat/greeks_tests.R

In derivmkts: Functions and R Code to Accompany Derivatives Markets

source('~/git/derivmkts/R/greeks.R')

library(testthat)
## we will generally use these parameters:
#kseq <- rep(c(35, 40, 45), times=3)
#Hseq <- rep(c(35, 40, 45), each=3)
#s <- 40; v <- 0.30; r <- 0.08;  tt <- 0.25; d <- 0.02

## The saved file has the parameter values used in the test along with
## the uppercased names of the functions, which have been downcased
## for this version file
#load('~/git/derivmkts/tests/testthat/option_testvalues.Rdata')
#load('option_testvalues.Rdata')
load('~/git/derivmkts/tests/testthat/option_testvalues.Rdata')
## for each function name, we will generate results believed correct
## from options.R. Then we will test against barriers.R

############################################################
## Remarks
############################################################
## Barrier options are particularly susceptible to numerical issues in
## computing greeks, especially when the price is near a barrier. The
## automated tests using barrier calculations fail, but the actual
## failures are small (generally on the order of 1e-06) and visual
## inspection shows no significant deviations. The testthat function
## shows only 10 results.
##
##So I turn off the greeks function checks for barriers. This is an
##issue I should probably revisit.

barrierchecks <- FALSE
barrierchecks <- TRUE
tol <- 5e-07
tol2 <- 1e-04 ## doesn't seem to make the check work


############################################################
## Tests
############################################################

test_that('greeks works bscall', {
              correct <- greeksvals[['bscall']]
              unknown <- greeks(bscall(s=s, k=kseq, v=v,
                                       r=r, tt=tt, d=d),
                                initcaps=TRUE)
              expect_equal(correct, unknown, tolerance=tol)
          }
          )
print('bscall greeks okay')

test_that('tidy greeks works bscall', {
              correct <- greeksvals2[['bscalltidy']]
              unknown <- greeks(bscall(s=s, k=kseq, v=v,
                                       r=r, tt=tt, d=d),
                                complete=TRUE, initcaps=FALSE)
              expect_equal(correct, unknown, tolerance=tol)
          }
          )
print('complete bscall greeks okay')

test_that('long tidy greeks works bscall', {
              correct <- greeksvals2[['bscalltidylong']]
              unknown <- greeks(bscall(s=s, k=kseq0, v=v,
                                       r=r, tt=tt, d=d),
                                long=TRUE,
                                initcaps=FALSE)
              expect_equivalent(correct, unknown, tolerance=tol)
              ## attributes aren't the same because of capitalization
          }
          )
print('complete long bscall greeks okay')


test_that('greeks2 works bscall', {
              correct <- greeksvals2[['bscall']]
              unknown <- greeks2(bscall, greeksinputs)
              expect_equal(correct, unknown, tolerance=tol)
          }
          )
print('bscall greeks2 okay')

## This is weird ... eyeballing the results, both seem equal. But
## they're not showing up as equal
if (barrierchecks) {
    test_that('greeks works assetuicall', {
        correct <- greeksvals[['assetuicall']]
        colnames(correct) <- tolower(colnames(correct))
        unknown <-
            greeks2(assetuicall, list(s=40, k=kseq, v=v,
                                      r=r, tt=tt, d=d, H=Hseq2)
                    )
        expect_equal(correct, unknown, tolerance=tol2)
    }
    )
    print('assetuicall greeks okay')
    test_that('greeks2 works assetuicall', {
        correct <- greeksvals2[['assetuicalltidy']]
        correct$funcname <- tolower(correct$funcname)
        unknown <- greeks(assetuicall(s=s, k=kseq, v=v,
                                      r=r, tt=tt, d=d, H=Hseq2),
                          complete=TRUE, initcaps=FALSE)
        expect_equal(correct, unknown, tolerance=tol2)
    }
    )
    print('assetuicall greeks2 okay')
    test_that('greeks2 works assetuicall', {
        correct <- greeksvals2[['assetuicall']]
        colnames(correct) <- tolower(colnames(correct))
        unknown <- greeks(assetuicall(s=s, k=kseq, v=v,
                                      r=r, tt=tt, d=d, H=Hseq2),
                          initcaps=TRUE)
        expect_equal(correct, unknown, tolerance=tol2)
    }
    )
    print('assetuicall greeks2 okay')
}