Financial Mathematics 2 - Homework 2

Instructor: Dr. Le Nhat Tan

For further discussion, please contact me via email: quannguyenuw@gmail.com.

1 Libraries

library(tidyverse)
library(ggplot2)
library(VNDS) # https://github.com/phamdinhkhanh/VNDS
library(yuima)

2 Problem 1

For each toss of a fair coin, you will win $$1$ if it lands up heads and lose $$1$ if it lands up tails. Suppose that you start the game with $$0$ and $M_k$ is the amount of money you obtain after $k$ tosses. Write an R code to simulate possible values of $M_{500}.$

toss_game_simulation = function(start, toss_count,
                                win, lose, head_probability) {
    earnings_by_game = sample(c(lose, win),
                              size = toss_count,
                              replace = T,
                              prob = c(1 - head_probability, head_probability))
    return(cumsum(earnings_by_game))
}

# One Sample Path
start = 0; toss_count = 500; win = 1; lose = -1; head_probability = 0.5
result = toss_game_simulation(start, toss_count, win, lose, head_probability)
plot(result, type = 'l', col = 'blue',
     xlab = 'Toss Count',
     ylab = 'Accumulated Money',
     main = 'One Sample Path')

# Multiple Sample Paths
num_path = 100; val = NA
for (i in 1:num_path) {
  x = 1:500
  y = toss_game_simulation(start, toss_count, win, lose, head_probability)
  val = rbind(val, data.frame(x, y, col = i))
}

ggplot(val, aes(x = x, y = y, col = factor(col))) +
  geom_line(show.legend = FALSE) +
  xlab('Toss Count') + 
  ylab('Accumulated Money') +
  ggtitle('Multiple Sample Paths')

# Histogram of M_500
ggplot(val %>% filter(x == 500), aes(x = y)) +
  geom_histogram(bins = 20) +
  xlab(expression(M[500])) +
  ylab('Count')

3 Problem 2

For each toss of a unfair coin, you will win $$3$ if it lands up heads and lose $$2$ if it lands up tails. The probability of landing up heads is $0.4$ and the probability of landing up tails is $0.6.$ Suppose that you start the game with $$0$ and $M_k$ is the amount of money you obtain after $k$ tosses.

Visualize an accumulated result of a game.
Write an R code to simulate possible results for playing the games $1000$ times.

# One Sample Path
start = 0; toss_count = 500; win = 3; lose = -2; head_probability = 0.4
result = toss_game_simulation(start, toss_count, win, lose, head_probability)
plot(result, type = 'l', col = 'blue',
     xlab = 'Toss Count',
     ylab = 'Accumulated Money',
     main = 'One Sample Path')

# Multiple Sample Paths
num_path = 1000; val = NA
for (i in 1:num_path) {
  x = 1:500
  y = toss_game_simulation(start, toss_count, win, lose, head_probability)
  val = rbind(val, data.frame(x, y, col = i))
}

ggplot(val, aes(x = x, y = y, col = factor(col))) +
  geom_line(show.legend = FALSE) +
  xlab('Toss Count') + 
  ylab('Accumulated Money') +
  ggtitle('Multiple Sample Paths')

# Histogram of M_500
ggplot(val %>% filter(x == 500), aes(x = y)) +
  geom_histogram(bins = 20) +
  xlab(expression(M[500])) +
  ylab('Count')

4 Problem 4

Plot a sample path of a Brownian motion $W_3$ with step size $1/100.$

brownian_motion = function(time, size) {
  step = time / size
  dWt = rnorm(size, mean = 0, sd = sqrt(step))
  Wt = cumsum(dWt)
  return(c(0, Wt))
}

time = 3; size = 100;
step = time / size
x = seq(0, time, step)
y = brownian_motion(time, size)
plot(x, y, type = 'l', col = 'blue',
     main = 'Sample Path', xlab = 'Time', ylab = expression(W[t]))

5 Problem 5

Plot $100$ sample paths of a drifted Brownian motion \[dX_t=2dt+4dW_t\] on $[0,2]$ with step size $1/10000.$

drifted_brownian_motion = function(time, size, mu, sigma) {
  # dXt = mu dt + sigma dWt
  step = time / size
  dWt = rnorm(size, mean = 0, sd = sqrt(step))
  dt = rep(step, length(dWt))
  dXt = mu * dt + sigma * dWt
  Xt = cumsum(dXt)
  return(c(0, Xt))
}

# One Sample Path
time = 2; size = 10000; mu = 2; sigma = 4
step = time / size
x = seq(0, time, step)
y = drifted_brownian_motion(time, size, mu, sigma)
plot(x, y, type = 'l', col = 'blue',
     main = 'Sample Path', xlab = 'Time', ylab = expression(W[t]))

# Multiple Sample Paths
num_path = 100; val = NA
for (i in 1:num_path) {
  step = time / size
  x = seq(0, time, step)
  y = drifted_brownian_motion(time, size, mu, sigma)
  val = rbind(val, data.frame(x, y, col = i))
}

ggplot(val, aes(x = x, y = y, col = factor(col), alpha = 0.1)) +
  geom_line(show.legend = FALSE) +
  xlab('Time') +
  ylab(expression(W[t])) +
  ggtitle('Multiple Sample Paths')

6 Problem 14

Simulate the geometric Brownian motion

\[dS_t=S_t(0.2dt+0.3dW_t)\]

on the interval $[0,3]$ with step size $1/10000.$

geometric_brownian_motion = function(start, time, size, mu, sigma) {
  # dSt = St(\mu dt + \sigma dWt)
  step = time / size
  dWt = rnorm(size, mean = 0, sd = sqrt(step))
  dt = rep(step, length(dWt))
  dSt_by_St = mu * dt + sigma * dWt
  return(cumprod(c(start, dSt_by_St + 1)))
}

# One Sample Path
start = 1; time = 3; size = 10000; mu = 0.2; sigma = 0.3
step = time / size
x = seq(0, time, step)
y = geometric_brownian_motion(start, time, size, mu, sigma)
plot(x, y, type = 'l', col = 'blue',
     main = 'Sample Path', xlab = 'Time', ylab = expression(W[t]))

# Multiple Sample Paths
num_path = 100; val = NA
for (i in 1:num_path) {
  x = seq(0, time, step)
  y = geometric_brownian_motion(start, time, size, mu, sigma)
  val = rbind(val, data.frame(x, y, col = i))
}

ggplot(val, aes(x = x, y = y, col = factor(col), alpha = 0.1)) +
  geom_line(show.legend = FALSE) +
  xlab('Time') +
  ylab(expression(W[t])) +
  ggtitle('Multiple Sample Paths')

7 Problem 15

Calibration parameters of geometric Brownian motion for VNM share prices. Consider the data of prices of VNM from $31/12/2014$ to $30/03/2020.$ Suppose $S_t,$ the price of VNM share at time $t,$ is governed by a geometric Brownian motion \[dSt=\mu S_tdt+\sigma S_tdWt.\] What are suitable values for $\mu$ and $\sigma?$

VNM = tq_get(symbol = 'VNM', from = '2014-12-31', to = '2020-03-30',
             src = 'CAFEF')

## #VNM from 2014-12-31 to 2020-03-30 already cloned

VNM = as.data.frame(VNM)
plot(VNM$date, VNM$close, type = 'l', col = 'blue',
     xlab = 'Time', ylab = 'Closing Price', main = 'VNM')

price = rev(VNM$close)
delta = 1 / 252
gBm = setModel(drift = "mu*x", diffusion = "sigma*x")
mod = setYuima(model = gBm, data = setData(price, delta = delta))
fit = qmle(mod, start = list(mu = 1, sigma = 1),
lower = list(mu = 0.001, sigma = 0.001),
upper = list(mu = 10, sigma = 10))
coef(summary(fit))

##        Estimate  Std. Error
## sigma 0.2838216 0.005754615
## mu    0.0309028 0.124721230

sigma = coef(summary(fit))[1]; mu = coef(summary(fit))[2]
start = price[1]; time = 1; size = length(price) - 1;
step = time / size
num_path = 500; val = NA
for (i in 1:num_path) {
  x = rev(VNM$date)
  y = geometric_brownian_motion(start, time, size, mu, sigma)
  val = rbind(val, data.frame(x, y, path = i, col = 'black'))
}
val = rbind(val, data.frame(x = VNM$date, y = VNM$close, path = 101, col = 'red'))

ggplot(val, aes(x, y, group = path)) +
  geom_line(data = val[val$col == 'black',], aes(color = 'GBM Sample Paths'),
            alpha = 0.2) +
  geom_line(data = val[val$col == 'red',], aes(color = 'VNM'), alpha = 2,
            size = 1.1) +
  scale_color_manual(values = c('black', 'red')) +
  theme_classic() +
  theme(legend.title = element_blank()) +
  xlab('Time') +
  ylab('Price') +
  ggtitle('VNM versus GBM Sample Paths')