Created
August 27, 2017 08:52
-
-
Save WilsonMongwe/2fe2aff3032d400e9c71f07fbe134898 to your computer and use it in GitHub Desktop.
Server file
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
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) | |
}) | |
}) | |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
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 (σ):"), | |
min = 0.2, | |
max = 0.4, | |
value = 0.25), | |
sliderInput("lambda", | |
HTML("Lambda (λ):"), | |
min = 2, | |
max = 5, | |
value = 3), | |
sliderInput("mu_jump", | |
HTML("Mean jump size (μ):"), | |
min = -0.1, | |
max = 0.05, | |
value = 0), | |
sliderInput("s_jump", | |
HTML("Jump size vol (β):"), | |
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