https://github.com/daqana/dqrng/issues/80

ahudde · Apr 20, 2024 · 057fbb5 · 057fbb5
1 parent d64531d
commit 057fbb5
Show file tree

Hide file tree

Showing 3 changed files with 36 additions and 24 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,6 +1,6 @@
 Package: greeks
 Title: Sensitivities of Prices of Financial Options and Implied Volatilities
-Version: 1.4.0
+Version: 1.4.2
 Authors@R: 
     person(given = "Anselm",
            family = "Hudde",

diff --git a/tests/testthat/test-Binomial_American_Greeks.R b/tests/testthat/test-Binomial_American_Greeks.R
@@ -95,7 +95,10 @@ test_that("Binomial_American_Greeks is correct", {
 
   }
 
-  expect(max(error) < 0.1)
+  expect(
+    max(error) < 0.1,
+    failure_message = "The results of Binomial_American_Greeks.R cannot be
+    confirmend by finite difference")
 
 })
 
@@ -210,6 +213,8 @@ test_that("Binomial_American_Greeks fair_value is correct", {
     )
 
   }
-  expect(max(error) < 1e-5)
+  expect(max(error) < 1e-5,
+         failure_message = "The results of Binomial_American_Greeks.R cannot be
+    confirmend by Binomial_Americian_Greeks_test")
 
 })
diff --git a/tests/testthat/test-Malliavin_Geometric_Asian_Greeks.R b/tests/testthat/test-Malliavin_Geometric_Asian_Greeks.R
@@ -1,11 +1,9 @@
 test_that("Malliavin_Geometric_Asian_Greeks is correct", {
 
-  # We check the Greeks by also computing the derivative with finite difference
-  # and comparing the results
-
+  # We check the Greeks by comparing with the exact results
   number_of_runs <- 8
 
-  Greeks <- c("fair_value", "delta", "vega", "theta", "rho", "gamma")
+  Greeks <- c("fair_value", "delta", "theta", "rho", "gamma")
 
   error <- matrix(nrow = number_of_runs, ncol = length(Greeks))
 
@@ -34,8 +32,8 @@ test_that("Malliavin_Geometric_Asian_Greeks is correct", {
         dividend_yield = dividend_yield,
         payoff = payoff,
         greek = Greeks,
-        paths = 10000,
-        steps = 24,
+        paths = 100000,
+        steps = 48,
         antithetic = antithetic
       )
 
@@ -51,13 +49,18 @@ test_that("Malliavin_Geometric_Asian_Greeks is correct", {
         greek = Greeks
       )
 
-    error[i, ] <-
-      min(abs(Value_MC - Value_exact)/(abs(Value_MC) + 1e-5),
-          abs(Value_MC - Value_exact))
+    for(j in 1:length(Greeks)) {
+      error[i, j] <-
+      min(abs(Value_MC[j] - Value_exact[j])/(abs(Value_MC[j]) + 1e-5),
+          abs(Value_MC[j] - Value_exact[j]))
+    }
 
   }
 
-  expect(max(error) < 0.01)
+  expect(
+    max(error) < 0.1,
+    failure_message = "The results of Malliavin_Geometric_Asian_Greeks.R cannot
+    be confirmend by BS_Geometric_Asian_Greeks.R")
 
   # We check, whether computation for vectorized parameters initial_value and
   # exercise price works
@@ -87,8 +90,8 @@ test_that("Malliavin_Geometric_Asian_Greeks is correct", {
       paths = 100)
 
   expect(max(abs(vectorized_initial_price[2, ] - single_initial_price)) < 1e-9,
-         "Malliavin_Geometric_Asian_Greeks: Vectorized computation wrt to
-         initial_value does not work")
+         failure_message = "Malliavin_Geometric_Asian_Greeks: Vectorized
+         computation wrt to initial_value does not work")
 
   vectorized_exercise_price <-
     Malliavin_Geometric_Asian_Greeks(
@@ -114,26 +117,30 @@ test_that("Malliavin_Geometric_Asian_Greeks is correct", {
       greek = Greeks,
       paths = 100)
 
-  expect(max(abs(vectorized_exercise_price[2, ] - single_exercise_price)) < 1e-9,
-         "Malliavin_Geometric_Asian_Greeks: Vectorized computation wrt to
-         exercise_price does not work")
+  expect(
+    max(abs(vectorized_exercise_price[2, ] - single_exercise_price)) < 1e-9,
+    failure_message =  "Malliavin_Geometric_Asian_Greeks: Vectorized computation
+    wrt to exercise_price does not work")
 
   # We check, whether custom payoff functions work
 
   digital_call <-
     function(x, exercise_price) {ifelse(x >= exercise_price, 1, 0)}
 
-  expect(max(abs(
-    Malliavin_Geometric_Asian_Greeks(payoff = digital_call, paths = 100) -
-      Malliavin_Geometric_Asian_Greeks(payoff = "digital_call", paths = 100))) < 1e-9,
-    "Malliavin_Geometric_Asian_Greeks: Custom payoff functions do not work")
+  expect(
+    max(abs(
+      Malliavin_Geometric_Asian_Greeks(payoff = digital_call, paths = 100) -
+        Malliavin_Geometric_Asian_Greeks(payoff = "digital_call", paths = 100))) < 1e-9,
+    failure_message =  "Malliavin_Geometric_Asian_Greeks: Custom payoff
+    functions do not work")
 
   digital_put <-
     function(x, exercise_price) {ifelse(x <= exercise_price, 1, 0)}
 
   expect(max(abs(
     Malliavin_Geometric_Asian_Greeks(payoff = digital_put, paths = 100) -
       Malliavin_Geometric_Asian_Greeks(payoff = "digital_put", paths = 100))) < 1e-9,
-    "Malliavin_Geometric_Asian_Greeks: Custom payoff functions do not work")
+    failure_message =  "Malliavin_Geometric_Asian_Greeks: Custom payoff
+    functions do not work")
 
-    })
+})