Annuity value with UFR method

server.R

library(shiny)
library(compiler)
source("SmithWilson.R")

# Define server logic required to draw a histogram
shinyServer(function(input, output) {
  
    output$distPlot <- renderPlot({
    year <- input$years
    ufr <- input$ufrs
    alpha <- input$alphas
    llp <- input$llps
    
    # draw the rates with the specified params
    par(mfrow=c(2, 1))
    res <- tZC_SW(UFR = ufr, alpha = alpha, LLP = llp, 
                  year.choice = year)
    abline(v = llp, lty = 2, 
           lwd = 2, col = "green")
    lim_x <- c(1, 159)
    barplot(res, 
            xlim = c(1, 159), 
            ylim = c(0, 100), 
            col = "darkgray", border = "white", 
            xlab = "maturity of the annuity", 
            ylab = "1 euro annuity value")
    abline(v = llp*2, lty = 2, 
           lwd = 2, col = "green")
    abline(h = 20, lty = 2)
    abline(h = 40, lty = 2)
    abline(h = 60, lty = 2)
    abline(h = 80, lty = 2)
  })
  
})

SmithWilson.R

# Wilson function
fonctionsWilson <- function(t,u,alpha,UFR)
{    
  N <- length(u)  
  J <- length(t)    
  u_mat <- matrix(rep.int(u,J), nrow=J, byrow=T)
  t_mat <- t(matrix(rep.int(t,N), nrow=N, byrow=T))
  min_u <- u_mat*(u_mat<=t_mat) + t_mat*(u_mat>t_mat)
  max_u <- u_mat + t_mat - min_u    
  return(exp(-UFR*(u_mat+t_mat))*(alpha*min_u - 0.5*exp(-alpha*max_u)*(exp(alpha*min_u)-exp(-alpha*min_u))))
}
fonctionsWilson <- cmpfun(fonctionsWilson)

# Implied fwd rate
fwd_rate <- function(P, tmat)
{ 
  (P[-length(tmat)]/P[-1] - 1)/diff(tmat)
}
fwd_rate <- cmpfun(fwd_rate)

# Rates from prices
rate_from_price <- function(P, tmat)
{ 
  as.vector((1-P)/(P*tmat))
}
rate_from_price <- cmpfun(rate_from_price)

# Prices from rates
price_from_rate <- function(yM, tmat)
{
  1/(1+yM*tmat)
}
price_from_rate <- cmpfun(price_from_rate)

# Valeur de rente par maturity
val_rente <- function(yM, tmat)
{
  cumsum(price_from_rate(yM, tmat))
}
val_rente <- cmpfun(val_rente)

# Smith-Wilson
tZC_SW <- function(UFR, alpha = 0.1, LLP = 30, year.choice = "1")
{  
  u <- 1:floor(LLP)
  t <- seq(from = 1, to = 80, by = 0.5)
  
  N <- length(u)  
  J <- length(t)
    
  mu <- exp(-UFR*u)
  W <- fonctionsWilson(u,u,alpha,UFR)    

  if (year.choice == "1") {
  p <- c(0.9859794,0.9744879,0.9602458,0.9416551,
         0.9196671,0.8957363,0.8716268,0.8482628,
         0.8255457,0.8034710,0.7819525,0.7612204,
         0.7416912,0.7237042,0.7072136,0.6922140,
         0.6785227,0.6660095,0.6546902,0.6441639,
         0.6343366,0.6250234,0.6162910,0.6080358,
         0.6003302,0.5929791,0.5858711,0.5789852,
         0.5722068,0.5653231)
  } else {
  p <- c(0.998393, 0.996509, 0.993485, 0.988784, 
          0.982295, 0.974011, 0.963584, 0.951028, 
          0.936662, 0.921188, 0.904927, 0.888570, 
          0.872079, 0.855560, 0.839361, 0.823259, 
          0.807707, 0.792068, 0.777430, 0.762908, 
          0.748743, 0.735006, 0.721565, 0.708465, 
          0.695751, 0.683243, 0.670962, 0.658698, 
          0.647173, 0.635698)
  }
  
  p_LLP <- p[1:LLP]
  
  Xhi <- solve(W)%*%(p_LLP-mu)
  W_interp <- fonctionsWilson(t,u,alpha,UFR)  
  P <- exp(-UFR*t) + W_interp %*%Xhi
  Fwd <- fwd_rate(P = P, tmat = t)
  yM <- rate_from_price(P, t)
 
# Viz  
 plot(t, yM, type = 'l', 
      xlim = c(0, 80),
      ylim = c(0.0015, 0.05), 
      xlab = "time to maturity", 
      ylab = "interest rates", col = "blue", lwd = 3)
 lines(t[-J], Fwd, col = "red", lwd = 3)
 leg.txt <- c("yield", "forward", "market rates", "llp")
 legend(x = 0, y = 0.05, leg.txt, 
        lwd=c(3, 3, 2, 2), lty = c(1, 1, 2, 2),
        col = c("blue", "red", "black", "green"))
  if (LLP < 30)
  {
    u_market <- 1:30
    bool <- (u_market >= LLP & u_market <= 30)
    u_market_bool <- u_market[bool]
    lines(u_market_bool, rate_from_price(p[bool], u_market_bool), 
          col = "black", lty = 2, lwd = 2)
    lines(u_market_bool[-length(u_market_bool)], fwd_rate(p[bool], u_market_bool), 
          col = "black", lty = 2, lwd = 2)
  } 
    return(val_rente(yM = yM, tmat = t))
}
tZC_SW <- cmpfun(tZC_SW)

ui.R

shinyUI(fluidPage(
  titlePanel("Annuity value with UFR method (by Thierry Moudiki)"),
  sidebarLayout(
    sidebarPanel(
      radioButtons("years", 
                   "Year",
                   choices = list("2011" = 1, 
                                  "2014" = 2),
                   selected = 1),
      sliderInput("ufrs",
                  "Ultimate Forward Rate",
                  min = 0.012,
                  max = 0.042,
                  value = 0.022),
      sliderInput("alphas",
                  "Speed of convergence",
                  min = 0.1,
                  max = 0.4,
                  value = 0.1),
      sliderInput("llps",
                  "Last liquid point",
                  min = 10,
                  max = 30,
                  value = 20)),
    mainPanel(
      plotOutput("distPlot", height = "650px")
    )
  )
))