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