Skip to content

Instantly share code, notes, and snippets.

@WilsonMongwe
Created August 27, 2017 08:52
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save WilsonMongwe/2fe2aff3032d400e9c71f07fbe134898 to your computer and use it in GitHub Desktop.
Save WilsonMongwe/2fe2aff3032d400e9c71f07fbe134898 to your computer and use it in GitHub Desktop.
Server file
library(shiny)
library(RQuantLib)
shinyServer(function(input, output) {
## The model class is the backbone of thsi application
model <- setClass(
# Set the name for the class
"model",
# Define the slots
slots = c(
s_0 = "numeric", # stock price
r ="numeric", # "risk-free rate"
d ="numeric", # dividend
sigma_s = "numeric", #diffsuive vole
mean_jump = "numeric", # average jump size
lambda ="numeric", #number of jumps
sigma_jump ="numeric" #jump vol
),
# Set the default values for the slots. (optional)
prototype=list(),
# Make a function that can test to see if the data is consistent.
validity=function(object)
{
if(object@sigma_s<0)
{
return("The diffusion vol is negative.")
}
if(object@s_0<0)
{
return("The intial stock price is negative.")
}
if(object@sigma_jump<0)
{
return("The jump vol is negative.")
}
if(object@lambda<0)
{
return("The jump vol is negative.")
}
return(TRUE)
}
)
setGeneric(name="setModelParam",
def=function(theObject,s_0Val,rVal,dVal,sigma_sVal,mean_jumpVal,lambdaVal,sigma_jumpVal)
{
standardGeneric("setModelParam")
})
setGeneric(name="simulateGbm",
def=function(theObject,n,dt,T,randomNumbers)
{
standardGeneric("simulateGbm")
})
setGeneric(name="eulerSimulateJump",
def=function(theObject,n,dt,T,randomNumbers)
{
standardGeneric("eulerSimulateJump")
})
setGeneric(name="hedgingExample",
def=function(theObject,optionType,s_0,strike,rate,dividend,vol,dt,T,model,randomNumbers)
{
standardGeneric("hedgingExample")
})
setMethod(f="setModelParam",
signature="model",
definition=function(theObject,s_0Val,rVal,dVal,sigma_sVal,mean_jumpVal,lambdaVal,sigma_jumpVal)
{
theObject@mean_jump<-mean_jumpVal
theObject$lambda<-lambdaVal
theObject$sigma_jump<-sigma_jumpVal
theObject@s_0 <-s_0Val
theObject@r <-rVal
theObject@d<- dVal
theObject@sigma_s<- sigma_sVal
validObject(theObject) # check s if the inputs are valid
return(theObject)
})
setMethod(f="simulateGbm",
signature="model",
definition=function(theObject,n,dt,T,randomNumbers)
{
initial=theObject@s_0
r=theObject@r
d=theObject@d
s=theObject@sigma_s
timeSteps=seq(0,T,dt)
stock = matrix(0,nrow=length(timeSteps),ncol = n)
stock[1,]=initial
for (time in 2:length(timeSteps)){
for (path in 1:n){
stock[time,path]=stock[time-1,path]*exp((r-d-0.5*s^2)*dt+s*sqrt(dt)*randomNumbers[time-1])
}
}
return(stock)
})
setMethod(f="eulerSimulateJump",
signature="model",
definition=function(theObject,n,dt,T,randomNumbers)
{
#Simulate the jump times and the corresponding jump sizes
sigma_ <- theObject@sigma_jump
lambda_ <-theObject@lambda
mu2_ <- theObject@mean_jump
TotalTime <- T #this time is in days (where the number of business days in a year is assumed to be 252)
Sn=0
times <- c(0)
while(Sn <= TotalTime)
{
n <- length(times)
u <- runif(1)
expon <- -log(u)/lambda_
Sn <- times[n]+expon
times <- c(times, Sn)
}
#times=times[-length(times)] #the last time is beyond TotalTime, so i delete from the vector times
indicator=seq(from=0,to=0,length=TotalTime) # if there are jumps or not between two times
jumpSize=seq(from=0,to=0,length=TotalTime) # stores the size of the jump
if(length(times)>0)
{
t=(0:(length=(TotalTime)-1))
for(m in 2:length(times))
{
for(k in 2: length(t))
{
if( t[k-1]<=times[m] && times[m]<=t[k])
{
indicator[k]=1
jumpSize[k]=rnorm(1,mean=mu2_,sd=sigma_)
}
}
}
}
## Simulate the log stock prce based on jump sizes and jump times
intial=theObject@s_0
r=theObject@r
d=theObject@d
s=theObject@sigma_s
stock = matrix(0,nrow=TotalTime,ncol = 1)
stock[1]=intial
for(i in 2:TotalTime)
{
stock[i]=stock[i-1]+(r-d-0.5*s^2)*dt+s*sqrt(dt)*randomNumbers[i-1]+jumpSize[i]*indicator[i]
}
return(stock) #returns the log stock price
}
)
setMethod(f="hedgingExample",
signature="model",
definition=function(theObject,optionType,s_0,strike,rate,dividend,vol,dt,T,model,randomNumbers)
{
k=strike
d=dividend
r=rate
s=vol
sampleSize=1
sigma_jump <- theObject@sigma_jump
lambda <-theObject@lambda
mean_jump <- theObject@mean_jump
optionType=tolower(optionType)
maturity=T*252
dataObject=theObject
timeSteps=seq(0,T,dt)
if(model=="GBM")
{
paths=simulateGbm(dataObject,sampleSize,dt,T,randomNumbers)
}
else
{
paths=eulerSimulateJump(dataObject,sampleSize,dt,maturity+1,randomNumbers)
paths=exp(paths)
}
## Store the price and the delta information
price = matrix(0,nrow=length(timeSteps),ncol = sampleSize)
delta = matrix(0,nrow=length(timeSteps),ncol = sampleSize)
for(i in 1:length(timeSteps))
{
for(j in 1:sampleSize)
{
object=EuropeanOption(type=optionType, underlying=paths[i,j], strike=k, dividendYield=d,
riskFreeRate=r, maturity=(T-timeSteps[i]), volatility=s)
# note that tthe diffusive vl is used to price the option
price[i,j]=object$value
delta[i,j]=object$delta
}
}
#store the pnl of the trade
pnlNohedge = matrix(0,nrow=length(timeSteps),ncol = sampleSize)
pnlDeltaHedge = matrix(0,nrow=length(timeSteps),ncol = sampleSize)
for(i in 2:(length(timeSteps)))
{
for(j in 1:sampleSize)
{
pnlNohedge[i-1,j]=price[i,j]-price[i-1,j]
change_in_S=paths[i,j]-paths[i-1,j]
pnlDeltaHedge[i-1,j]=pnlNohedge[i-1,j]-delta[i-1,j]*(change_in_S)
}
}
# store the results of the calculations
result = matrix(0,nrow=length(pnlNohedge),ncol = 4)
result[,1]=timeSteps;
result[,2]=pnlNohedge;
result[,3]=pnlDeltaHedge;
result[,4]=paths;
return(result)
}
)
## Start of the Server
randomInput <- reactive({ Z=rnorm(1000,0,1)})
datasetInput <- reactive({
## random numbers
initial=input$s_0
k=input$Strike
d=input$d
r=input$r
maturity=input$maturity*252
s=input$s
dt=1/252
mean_jump = input$mu_jump
lambda =input$lambda*dt
sigma_jump =input$s_jump
model=input$model
optiontype=input$call_put
Z<-randomInput()
if(model=="GBM")
{
w<-model(s_0=initial,r=r,d=d,sigma_s=s,mean_jump=mean_jump,lambda=lambda,sigma_jump=sigma_jump)
result=hedgingExample(w,optiontype,initial,k,r,d,s,dt,maturity*dt,model,Z)
}
if(model=="JumpDiffusion")
{
spot=log(initial)
w<-model(s_0=spot,r=r,d=d,sigma_s=s,mean_jump=mean_jump,lambda=lambda,sigma_jump=sigma_jump)
result=hedgingExample(w,optiontype,spot,k,r,d,s,dt,maturity*dt,model,Z)
}
result
})
output$path <- renderPlot({
size=input$maturity*252+1
result <-datasetInput()
plot(result[1:size,1],result[,4],type='l',xlab="Time",ylab="Stock Price",main="Stock Price Path",col="blue")
})
output$hedge <- renderPlot({
result <-datasetInput()
size=length(result[,1])
units=input$notional
plot(result[1:(size-2),1],result[1:(size-2),2]*units,type="l",col="red",xlab="Time",ylab="pnL",ylim=c(min(result[1:(size-2),2]*units), max(result[1:(size-2),2])*units),main="PnL Over Time")
lines(result[1:(size-2),1],result[1:(size-2),3]*units,col="green")
legend("topright", inset=.05,
c("UnhedgedPnL","DeltaHedgedPnL"), fill=c("red","green"), horiz=TRUE)
})
})
library(shiny)
library(shinydashboard)
shinyUI(fluidPage(
# Application title
titlePanel("European Option Hedging Example"),
fluidRow(
tags$style(HTML(".js-irs-0 .irs-single, .js-irs-0 .irs-bar-edge, .js-irs-0 .irs-bar {background: green}")),
tags$style(HTML(".js-irs-1 .irs-single, .js-irs-1 .irs-bar-edge, .js-irs-1 .irs-bar {background: green}")),
tags$style(HTML(".js-irs-2 .irs-single, .js-irs-2 .irs-bar-edge, .js-irs-2 .irs-bar {background: green}")),
tags$style(HTML(".js-irs-3 .irs-single, .js-irs-3 .irs-bar-edge, .js-irs-3 .irs-bar {background: blue}")),
tags$style(HTML(".js-irs-4 .irs-single, .js-irs-4 .irs-bar-edge, .js-irs-4 .irs-bar {background: blue}")),
tags$style(HTML(".js-irs-5 .irs-single, .js-irs-5 .irs-bar-edge, .js-irs-5 .irs-bar {background: blue}")),
tags$style(HTML(".js-irs-6 .irs-single, .js-irs-6 .irs-bar-edge, .js-irs-6 .irs-bar {background: purple}")),
tags$style(HTML(".js-irs-7 .irs-single, .js-irs-7 .irs-bar-edge, .js-irs-7 .irs-bar {background: purple}")),
tags$style(HTML(".js-irs-8 .irs-single, .js-irs-8 .irs-bar-edge, .js-irs-8 .irs-bar {background: purple}")),
tags$style(HTML(".js-irs-9 .irs-single, .js-irs-9 .irs-bar-edge, .js-irs-9 .irs-bar {background: purple}")),
column(4,
selectInput("call_put",
label = "Option Type",
choices = list("Call", "Put"),
selected = "Call"),
sliderInput("notional",
"Number of Units (N):",
min = 1,
max = 2,
value = 1),
sliderInput("maturity",
"Maturity (T):",
min = 1,
max = 3,
value = 1),
sliderInput("Strike",
"Strike (K):",
min = 100,
max = 200,
value = 110)
),
column(4,
selectInput("model",
label = "Underlying Model",
choices = list("GBM", "JumpDiffusion"),
selected = "GBM"),
sliderInput("s_0",
"Initial stock price:",
min = 100,
max = 200,
value = 110),
sliderInput("r",
"Risk free rate (r):",
min = 0.001,
max = 0.15,
value = 0.05),
sliderInput("d",
"Dividend yield (d):",
min = 0.001,
max = 0.1,
value = 0.01)
),
column(4,
sliderInput("s",
HTML("Diffusive vol (&sigma;):"),
min = 0.2,
max = 0.4,
value = 0.25),
sliderInput("lambda",
HTML("Lambda (&lambda;):"),
min = 2,
max = 5,
value = 3),
sliderInput("mu_jump",
HTML("Mean jump size (&mu;):"),
min = -0.1,
max = 0.05,
value = 0),
sliderInput("s_jump",
HTML("Jump size vol (&beta;):"),
min = 0.001,
max = 0.21,
value = 0.1)
)
),
fluidRow(
plotOutput("path"),
plotOutput("hedge")
)
))
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment