Server file

server.R

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)
    
  })
})

ui.R

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")
    )
))