Extended test-BS_European_Greeks

tests/testthat/test-BS_European_Greeks.R

@@ -1,24 +1,33 @@
 test_that("BS_European_Greeks is correct", {
 
-  # TODO: more Greeks
-
   # We check the Greeks by also computing the derivative with finite difference
   # and comparing the results
 
-  number_of_runs <- 100
-
-  dict_greeks_params <- list(
-    initial_price = "delta",
-    volatility = "vega",
-    time_to_maturity = "theta",
-    r = "rho",
-    dividend_yield = "epsilon"
-  )
+  number_of_runs <- 1000000
+
+  definition_of_geeks <-
+    data.frame(greek = "charm", start = "theta", param = "initial_price") %>%
+    add_row(greek = "delta", start = "fair_value", param = "initial_price") %>%
+    add_row(greek = "epsilon", start = "fair_value", param = "dividend_yield") %>%
+    add_row(greek = "gamma", start = "delta", param = "initial_price") %>%
+    add_row(greek = "rho", start = "fair_value", param = "r") %>%
+    add_row(greek = "theta", start = "fair_value", param = "time_to_maturity") %>%
+    add_row(greek = "vanna", start = "delta", param = "volatility") %>%
+    add_row(greek = "vega", start = "fair_value", param = "volatility") %>%
+    #add_row(greek = "vera", start = "rho", param = "volatility") %>%
+    #add_row(greek = "veta", start = "vega", param = "time_to_maturity") %>%
+    #add_row(greek = "vomma", start = "vega", param = "volatility") %>%
+    add_row(greek = "speed", start = "gamma", param = "initial_price") %>%
+    add_row(greek = "zomma", start = "vanna", param = "initial_price") #%>%
+    #add_row(greek = "color", start = "gamma", param = "time_to_maturity") %>%
+    #add_row(greek = "ultima", start = "vomma", param = "volatility")
 
   error <- numeric(number_of_runs)
 
   set.seed(42)
 
+  epsilon <- 1e-5
+
   for(i in 1:number_of_runs) {
 
     # the parameters are chosen at random
@@ -27,12 +36,19 @@ test_that("BS_European_Greeks is correct", {
     r <- runif(1, -0.01, 0.1)
     time_to_maturity <- runif(1, 0.2, 6)
     dividend_yield <- runif(1, 0, 0.1)
-    volatility <- runif(1, 0, 1)
+    volatility <- runif(1, 0.001, 1)
     model <- "Black_Scholes"
-    payoff <- sample(c("call", "put"), 1)
-    param <- sample(names(dict_greeks_params), 1)
+    payoff <- sample(c("call", "put",
+                       "cash_or_nothing_call", "cash_or_nothing_put",
+                       "asset_or_nothing_call", "asset_or_nothing_put"), 1)
+    greek <- sample(definition_of_geeks$greek, 1)
+    param <-
+      definition_of_geeks[definition_of_geeks$greek == greek, "param"] %>%
+      as.character()
+    start <-
+      definition_of_geeks[definition_of_geeks$greek == greek, "start"] %>%
+      as.character()
 
-    epsilon <- 1e-5
     Vals <-
       BS_European_Greeks(
         initial_price = initial_price,
@@ -42,7 +58,7 @@ test_that("BS_European_Greeks is correct", {
         volatility = volatility,
         dividend_yield = dividend_yield,
         payoff = payoff,
-        greek = dict_greeks_params[[param]]
+        greek = greek
       )
 
     if (param == "time_to_maturity") {
@@ -59,14 +75,22 @@ test_that("BS_European_Greeks is correct", {
         volatility = volatility,
         dividend_yield = dividend_yield,
         payoff = payoff,
-        greek = "fair_value"
+        greek = start
       )
 
     }
 
     Vals_fd <- (F(epsilon) - F(-epsilon)) / (2 * epsilon)
-    error[i] <- abs(Vals - Vals_fd)/(abs(Vals + epsilon))
-
+    error[i] <-
+      error[i] <-
+      min(abs(Vals - Vals_fd)/(abs(Vals + epsilon)),
+          abs(Vals - Vals_fd))
+    # TODO: diesen Teil löschen
+    if(error[i] > sqrt(epsilon)){
+      print(greek)
+      print(param)
+      print(error[i])
+    }
   }
 
   expect(max(error) < sqrt(epsilon))