## Not run:
# # These are similar to the MLMC tests for the original
# # 2008 Operations Research paper, using an Euler-Maruyama
# # discretisation with 4^l timesteps on level l.
# #
# # The differences are:
# # -- the plots do not have the extrapolation results
# # -- two plots are log_2 rather than log_4
# # -- the new MLMC driver is a little different
# # -- switch to X_0=100 instead of X_0=1
#
# M <- 4 # refinement cost factor
# N0 <- 1000 # initial samples on coarse levels
# Lmin <- 2 # minimum refinement level
# Lmax <- 6 # maximum refinement level
#
# test.res <- list()
# for(option in 1:5) {
# if(option==1) {
# cat("\n ---- Computing European call ---- \n")
# N <- 2000000 # samples for convergence tests
# L <- 5 # levels for convergence tests
# Eps <- c(0.005, 0.01, 0.02, 0.05, 0.1)
# } else if(option==2) {
# cat("\n ---- Computing Asian call ---- \n")
# N <- 2000000 # samples for convergence tests
# L <- 5 # levels for convergence tests
# Eps <- c(0.005, 0.01, 0.02, 0.05, 0.1)
# } else if(option==3) {
# cat("\n ---- Computing lookback call ---- \n")
# N <- 2000000 # samples for convergence tests
# L <- 5 # levels for convergence tests
# Eps <- c(0.01, 0.02, 0.05, 0.1, 0.2)
# } else if(option==4) {
# cat("\n ---- Computing digital call ---- \n")
# N <- 3000000 # samples for convergence tests
# L <- 5 # levels for convergence tests
# Eps <- c(0.02, 0.05, 0.1, 0.2, 0.5)
# } else if(option==5) {
# cat("\n ---- Computing Heston model ---- \n")
# N <- 2000000 # samples for convergence tests
# L <- 5 # levels for convergence tests
# Eps <- c(0.005, 0.01, 0.02, 0.05, 0.1)
# }
#
# test.res[[option]] <- mlmc.test(opre_l, M, N, L, N0, Eps, Lmin, Lmax, option=option)
#
# # print exact analytic value, based on S0=K
# T <- 1
# r <- 0.05
# sig <- 0.2
# K <- 100
#
# d1 <- (r+0.5*sig^2)*T / (sig*sqrt(T))
# d2 <- (r-0.5*sig^2)*T / (sig*sqrt(T))
#
# if(option==1) {
# val <- K*( pnorm(d1) - exp(-r*T)*pnorm(d2) )
# cat(sprintf("\n Exact value: %f, MLMC value: %f \n", val, test.res[[option]]$P[1]))
# } else if(option==3) {
# k <- 0.5*sig^2/r
# val <- K*( pnorm(d1) - pnorm(-d1)*k - exp(-r*T)*(pnorm(d2) - pnorm(d2)*k) )
# cat(sprintf("\n Exact value: %f, MLMC value: %f \n", val, test.res[[option]]$P[1]))
# } else if(option==4) {
# val <- K*exp(-r*T)*pnorm(d2)
# cat(sprintf("\n Exact value: %f, MLMC value: %f \n", val, test.res[[option]]$P[1]))
# }
#
# # plot results
# plot(test.res[[option]])
# }
# ## End(Not run)
# The level sampler can be called directly to retrieve the relevant level sums:
opre_l(l=7, N=10, option=1)
Run the code above in your browser using DataLab