Week 10

library(tidyverse)

## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr     1.1.2     ✔ readr     2.1.4
## ✔ forcats   1.0.0     ✔ stringr   1.5.0
## ✔ ggplot2   3.4.3     ✔ tibble    3.2.1
## ✔ lubridate 1.9.2     ✔ tidyr     1.3.0
## ✔ purrr     1.0.2     
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag()    masks stats::lag()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors

int_formula <- function(x){
  formula <- x^3 * sin((x +3.4)/2)
} 



x_plot <- seq(0,3, length.out = 1000)
y_plot <- int_formula(x_plot)

plot(x_plot, y_plot, xlab ="x-values", ylab = "y-values", main = "f(x)", type = "l")

n<- 50000
x <-runif(n, min = 0, max = 3)
monte_int <- int_formula(x)

#multiply by length of interval

ans_monte <- 3 * mean (monte_int)
ans_monte

## [1] 4.649154

int_val <- integrate(int_formula, 0, 3)
int_val

## 4.652802 with absolute error < 5.4e-14

Question 2: Stock prices

set.seed(5003)

vol <- c(0.1,0.25,0.5,0.75,1)

drift <- 0.05

price <- 100

stock_sim <- function(ndays = 90, S0 = 100, mu = 0.05, vol = 0.5){
  N <- rnorm(ndays)
  S <- S0
  dT <- 1/365
  price_sim <- S
  
  for (i in 1:ndays){
    dS <- S * (mu*dT + vol * sqrt(dT) * N[i])
    S <- S + dS
    price_sim <- c(price_sim, S)
  }
  
  price_sim
  
}

sim_prices <- unlist(lapply(vol, function(s) stock_sim(vol = s)))

price_df <- data.frame(days = rep(0:90, 5),
                       prices = sim_prices,
                       Vol = factor(rep(vol, each = 91)))

ggplot(price_df)+
  theme_minimal()+
  geom_line(aes(x = days, y = prices, group = Vol, colour = Vol))

knockout_payoff <- function(stock_price, strike, knockout){
  if(any(stock_price > knockout))
    return(0)
  payoffs <- pmax(tail(stock_price, 1) - strike, 0)
  return(payoffs)
}

vanilla_pay <- function(stock_price, strike){
  max(stock_price- strike, 0)
}

Question 2.3: Pricing a knocout option

##knockout option has intial price = 100, 0.05 drift, vol = 0.5 and knockout = 130. Lets simulate this stock 10000 times

n <- 10000

ko_df = data.frame(option_number = integer(0), ko_payoff = numeric(0), vanilla_payoff = numeric(0), last_price = numeric(0), max_price = numeric(0))



for (i in 1:n){
  ko_prices <- stock_sim()
  #print(max(ko_prices))

  ko_payoff <- knockout_payoff(ko_prices, 105, 130)
  
  vanilla_payoff <- vanilla_pay(ko_prices[length(ko_prices)], 105)
  
  temp_df <- data.frame(
    option_number = i,
    ko_payoff = ko_payoff, 
    vanilla_payoff = vanilla_payoff,
    last_price = ko_prices[length(ko_prices)],
    max_price = max(ko_prices))
  
  ko_df <- rbind(ko_df, temp_df)
  
}

mean(ko_df$ko_payoff)

## [1] 1.464374

mean(ko_df$vanilla_payoff)

## [1] 8.702016

ko_payouts <- sum(ko_df$ko_payoff !=0)

vanilla_payouts <- sum(ko_df$vanilla_payoff != 0)

vanilla_payouts-ko_payouts

## [1] 2269

Discussion

The knockout option should be much cheaper than the vanilla option with an expected value of 1.46 compared with the vanilla options expected value being 8.70. If we look at the distribution of payoffs in the below boxplot and dotplots we see that the knockout clause kicks in often. We can calculate this exactly to be 2269 times.
Please do not remove marks for the lack of legend in the dotplot. I feel it adds value and geom_dotpoint either does not allow stacking very nicely if we melt the dataframe or does not allow you to manually add a legend

ko_df <- select(ko_df, -c(last_price, max_price))
library(reshape2)

## 
## Attaching package: 'reshape2'

## The following object is masked from 'package:tidyr':
## 
##     smiths

melted_df <- melt(ko_df, id.vars = "option_number")


ggplot(melted_df, aes(x = variable, y = value)) +
  geom_boxplot() + theme_minimal() +
  labs(
    x = "Payoff Type",
    y = "Payoff Value",
    title = "Boxplot of Vanilla Option vs. Knockout Option Payoffs"
  )

ggplot(ko_df, aes(x = option_number, ))

ggplot(ko_df, aes(x = option_number, y = vanilla_payoff, group = 1)) +
  geom_dotplot(binaxis = "y", stackdir = "center", binwidth = 1, fill = "blue", color = "blue", alpha = 0.5, show.legend = TRUE) +
  geom_dotplot(aes(x = option_number, y = ko_payoff, group = 2), binaxis = "y", stackdir = "center", binwidth = 1, fill = "red", color = "red", alpha = 0.5, show.legend = TRUE) +
  labs(
    x = "Iterations",
    y = "Payoff",
    title = "Distribution of Vanilla and Knockout Option Payoffs"
  ) +
  theme_minimal() +
scale_color_manual(values = c("Vanilla" = "blue", "KO" = "red")) +
  scale_fill_manual(values = c("Vanilla" = "blue", "KO" = "red")) +
  scale_color_identity(guide = "legend", name = "Distribution", labels = c("Vanilla", "KO")) +
  scale_fill_identity(guide = "legend", name = "Distribution", labels = c("Vanilla", "KO"))

## Scale for colour is already present.
## Adding another scale for colour, which will replace the existing scale.
## Scale for fill is already present.
## Adding another scale for fill, which will replace the existing scale.

  #scale_x_continuous(breaks = seq(0, max(ko_df$option_number), by = 2500))

ggplot(melted_df, aes(x = option_number, y = value, fill = variable)) +
  geom_dotplot(binaxis = "y", stackdir = "center", binwidth = 1, alpha = 0.5) +
  labs(
    x = "Option Number",
    y = "Payoff",
    title = "Dotplot of Vanilla and KO Payoffs"
  ) +
  scale_fill_manual(values = c("vanilla_payoff" = "blue", "ko_payoff" = "red"))+
  theme_minimal()

Week 10

2023-10-11

Question 2: Stock prices

Question 2.3: Pricing a knocout option

Discussion