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 (σ):"), | |
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