R code for Arbitrage-Free Nelson-Siegel-Svensson (AFNSS) model

This post provides an R code for the 4-factor Arbitrage-Free Nelson-Siegel-Svensson (AFNSS) model developed by Lee (2024).

A great book showcasing remarkable achievements in the Dynamic Nelson-Siegel model and its extensions.


AFNSS model



DNS and AFNS models, and their multi-factor extensions


Diebold and Li (2006) along with Diebold et al. (2006) pioneered the dynamic Nelson-Siegel (DNS) model. By incorporating dynamics of state variables into the Nelson-Siegel (1987) model, they demonstrated its empirical success.

Subsequently, Christensen et al. (2011) strengthened the DNS model's theoretical foundation by enforcing the arbitrage-free (AF) restriction, giving rise to the well-known 3-factor Arbitrage-free Nelson-Siegel (AFNS) model.

Naturally, the 4-factor DNSS model is expected to be transformed into an affine arbitrage-free model, however, Christensen et al. (2009) show that it is not possible to obtain the AF class of DNSS model with matching the Svensson loadings exactly.

To avoid this difficulty, they add a second slope factor and derive the arbitrage-free generalized Nelson-Siegel (AFGNS) model. In fact, the AFGNS model is a 5-factor model since it is the AF class of the dynamic generalized Nelson-Siegel (DGNS) model. Therefore, a four-factor arbitrage-free Nelson-Siegel-Svensson (AFNSS) model has not yet been developed.



Introducing 4-factor AFNSS model


Since the DNSS model is popular but lacks theoretical rigor, it's crucial to develop an essential AFNSS model, even with some modifications, while preserving most characteristics of the DNSS model. To achieve this objective, I derive an AFNSS model by applying a slight modification to the mean-reversion matrix under the risk-neutral Q measure.

Despite this slight modification, the model retains a highly similar functional form, nearly identical empirical fits, and comparable estimated yield curve factors to the DNSS model. Details on this new AFNSS model can be found in the following working paper, which is currently under the review process.


Lee, S.-H. (2024), An Arbitrage-Free Nelson-Siegel-Svensson Term Structure model, working paper. https://ssrn.com/abstract=4769455


Now, we can summarize a comprehensive overview of both dynamic and arbitrage-free classes of Nelson-Siegel models, alongside their multi-factor extensions, as can be seen in the following table.

Number of factors Dynamic model Arbitrage-Free model
3-factor DNS AFNS
4-factor DNSS AFNSS
5-factor DGNS AFGNS



AFNSS model structure


The AFNSS model can be expressed as a state-space model as follows.
\begin{align} y_t (\boldsymbol{\tau}) &= B(\boldsymbol{\tau}) X_t - \frac{A(\boldsymbol{\tau})}{\boldsymbol{\tau}} + \epsilon_t (\boldsymbol{\tau}) \\ dX_t &= K^P (\theta^P - X_t) dt + \Sigma dW_t^P \end{align}

where other terms except the factor loading matrix and the following yield-adjustment term are the same as the AFNS model, with appropriate dimensions.

The yield-adjustment term in the AFNSS model is as follows.




R code


The R code for the independent-factor AFNSS model is implemented as follows. I use the so-called DRA data of Diebold et al. (2006), which is representative U.S. yield curve data. The DRA data can be downloaded from the following link:
"http://econweb.umd.edu/~webspace/aruoba/research/paper5/DRA%20Data.txt".



#================================================================#
# R code for Arbitrage-free Nelson-Siegel-Svensson (AFNSS) model
#----------------------------------------------------------------
# written by Sang-Heon Lee (shlee725@gmail.com)
#
# Reference: 
#
#     Lee, S.-H. (2024), An Arbitrage-Free Nelson-Siegel-Svensson 
# Term Structure model, https://ssrn.com/abstract=4769455
#
# Comments are welcome.
#================================================================#
 
library(expm)
 
graphics.off(); rm(list = ls()) # remove all files from your workspace
 
setwd("your folder")
 
# Yield-adjustment term
AFNSS.YAT.analytic.func <- function(s, la, tau) {
    
    n <- la[1]; m <- la[2]; t <- tau
    n2 <- n^2; m2 <- m^2
    
    vs <- rep(NA, 10)
    vs[1]  <- sum(s[1,]^2)
    vs[2]  <- sum(s[2,]^2)    
    vs[3]  <- sum(s[3,]^2)
    vs[4]  <- sum(s[4,]^2)    
    vs[5]  <- sum(s[1,]*s[2,])
    vs[6]  <- sum(s[1,]*s[3,])
    vs[7]  <- sum(s[1,]*s[4,])
    vs[8]  <- sum(s[2,]*s[3,])
    vs[9]  <- sum(s[2,]*s[4,])
    vs[10<- sum(s[3,]*s[4,])
    
    rs <- vr <- matrix(NA, length(t), 10)
    sS <- function(la) { return((1-exp(-la*t))/(la*t)) }
    sC <- function(la) { return((1-exp(-la*t))/(la*t)-exp(-la*t)) }
    fS <- function(la) { return(exp(-la*t))}
    fC <- function(la) { return(la*t*exp(-la*t)) }
    
    vr[,1]  <- t^2/6
    vr[,2]  <- (1/n2)*(1/2-sS(n)+0.5*sS(2*n))
    vr[,3]  <- (1/n2)*(1/2 + fS(n) - (1/8)*fC(2*n) - (3/4)*fS(2*n) - 2*sS(n) + (5/4)*sS(2*n))
    vr[,4]  <- (1/(n2*m2))*(((n-m)^2)/2 + (1/t)*(n+m-n^2/m-m^2/n) + 
               ((n-m)/t)*((n/m)*fS(m) - (m/n)*fS(n)) + n^2/2*sS(2*m) + m^2/2*sS(2*n) - n*m*sS(n+m))
    vr[,5]  <- (1/n)*(t/2 - (1/n)*sC(n))
    vr[,6]  <- (1/n)*(t/2 + t*fS(n) - (3/n)*sC(n))
    vr[,7]  <- (1/m-1/n)*(t/2- (1/m2)*sC(m) + (1/n2)*sC(n)
    vr[,8]  <- (1/n2)*(1 + fS(n) - (1/2)*fS(2*n) - 3*sS(n) + (3/2)*sS(2*n))
    vr[,9]  <- (1/n )*((1/n)*2*sS(n) - sS(2*n) - 1+ (1/m)*(1 - sS(n) - sS(m) + sS(n+m))) 
    vr[,10<- (1/n2)*(3*sS(n) - sS(2*n) - 1 - fS(n)) + (1/(m*(n+m)))*(sS(n+m) - fS(n+m)) + 
               (1/(n*m))*(1 + fS(n) - sS(m) - 2*sS(n) + sS(n+m)) - (1/(2*n2))*( sS(2*n) - fS(2*n))
    
    for(i in 1:10) rs[,i]  = vs[i]*vr[,i]
    
    return(rowSums(rs))
}
 
# factor loading matrix
AFNSS.factor_loading <- function(lambda, maty){
    la1 <- lambda[1]; la2 <- lambda[2]
    col1 <- rep.int(1,length(maty))
    col2 <- (1-exp(-la1*maty))/(la1*maty)
    col3 <- col2-exp(-la1*maty) 
    col4 <- (1-exp(-la2*maty))/(la2*maty)-col2
    return( cbind(col1,col2,col3,col4))
}
 
# parameter restrictions
AFNSS.trans <- function(b0) {
    b1 <- b0
    b1[ 9:12<- b0[ 9:12]^2 # sigma
    b1[13:29<- b0[13:29]^2 # H
    # lambda1 > lambda2
    b1[30<- b0[30]^2 + b0[31]^2
    b1[31<- b0[31]^2
    return(b1)
}
 
# negative log likelihood function to be minimized
AFNSS.objf<-function(para_un) {
    
    nmat <- length(maty); nobs<- nrow(yield)
    
    # parameter restrictions
    para_con <- AFNSS.trans(para_un)
    kappa  <- diag(para_con[1:4])
    theta  <- para_con[5:8]; 
    sigma  <- diag(para_con[9:12])
    H      <- diag(para_con[13:29])
    lambda <- para_con[30:31]
    
    Phi1  <- expm(-kappa*dt)
    Phi0  <- (diag(nf)-Phi1)%*%theta
    
    # Conditional and Unconditional covariance matrix : Q, Q0
    m    <- eigen(kappa) 
    eval <- m$values; evec <- m$vectors; ievec<-solve(evec)
    Smat <- ievec%*%sigma%*%t(sigma)%*%t(ievec)
    Vdt  <- Vinf <- matrix(0,nf,nf)
    for(i in 1:nf) { for(j in 1:nf) {
        Vdt[i,j] <-Smat[i,j]*(1-exp(-(eval[i]+eval[j])*dt))/(eval[i]+eval[j])
        Vinf[i,j]<-Smat[i,j]/(eval[i]+eval[j])
    }}
    # Analytical Covariance matrix
    Q <- evec%*%Vdt%*%t(evec); Q0 <- evec%*%Vinf%*%t(evec)
    
    # factor loading matrix
    B <- AFNSS.factor_loading(lambda, maty); tB <- t(B)
    
    # Yield adjustment term
    C_yat <- AFNSS.YAT.analytic.func(sigma, lambda, maty)
    
    #------------------------------------------------
    # Eigenvalue check
    #------------------------------------------------    
    eval <- eigen(kappa)$values
    if(is.complex(eval)) {
        # Check if the real part of all eigenvalues is positive
        all_positive <- all(Re(eval) > 0)
        # Not all eigenvalues have positive real parts
        if (!all_positive) return(100000000)
    } else { # real
        # Check if all eigenvalues are positive
        all_positive <- all(eval > 0)
        # Not all eigenvalues are positive
        if (!all_positive) return(100000000)
    }
    
    #------------------------------------------------
    # Penalty for two lambda for feasible values
    #------------------------------------------------    
        la1 <- lambda[1]; la2 <- lambda[2]
        
        # 1) maximum loading maturity is less than max(maturity)
        if(max(B[,nf]) == B[nmat,nf]) return (100000000);
        
        # tau-star
        f_slo <- function(la,m) { return( (1-exp(-la*m))/(la*m) ) }
        f_cur <- function(la,m) { return( (1-exp(-la*m))/(la*m)-exp(-la*m) ) }
        # intersection of C1 and C2 : maximum of AC2
        f_err <- function(m, la1, la2) {return(f_cur(la2,m)-f_cur(la1,m))}
        f_sqr <- function(m, la1, la2) {return(f_err(m, la1, la2)^2)}
        tau_star <- uniroot(f_err, c(0.00110000), 
                            tol = 0.000001, la1 = la1, la2 = la2)
        
        # 2) tau-star is larger than (tau(la1) + 1 year)
        if(1.8/la1 + 1 > tau_star$root) return (100000000)
    #------------------------------------------------
    
    # initialization
    prevX <- theta; prevV <- Q0
    
    loglike <- 0
    for (t in 1:nobs) {
        # prediction
        Xhat <- Phi0+Phi1%*%prevX;
        Vhat <- Phi1%*%prevV%*%t(Phi1)+Q
        # measurement error
        y_real <- yield[t,]  # measurement of y
        y_fit  <- B%*%Xhat - C_yat   # prediction of y
        v <- y_real - y_fit  # error
        # updating
        ev <- B%*%Vhat%*%tB + H
        ev <- (ev+t(ev))/2 # symmetric
        if(is.nan(log(det(ev)))) return(100000000)
        evinv <- solve(ev)        # invpd(ev)
        KG <- Vhat%*%tB%*%evinv   # Kalman Gain
        prevX <- Xhat+KG%*%v        # E[X|y_t]   updated mean
        prevV <- Vhat-KG%*%B%*%Vhat # Cov[X|y_t] updated cov
        # log likelihood function
        loglike <- loglike - 0.5*(nmat)*log(2*pi)-0.5*log(det(ev))-0.5*t(v)%*%evinv%*%v
    }
    return(-loglike)
}
 
#===============================================================================
# Main ; Independent-factor AFNSS model estimation
#===============================================================================
dt <- 1/12; nf <- 4
 
#fn <- "http://econweb.umd.edu/~webspace/aruoba/research/paper5/DRA%20Data.txt"
fn <- "DRA_Data.txt"
df <- read.delim(fn, header=T)
yield <- as.matrix(df[,2:18]/100)
maty <- c(3,6,9,12,15,18,21,24,30,36,48,60,72,84,96,108,120)/12
nmat <- length(maty); nobs <- nrow(yield)
 
#------------------------------------------------
# Initial guesses : A, U, Q, H, lambda1, lambda2
#------------------------------------------------
init_par <- c(
    # A
    0.1434196065906410.6228328897434881.663589977513090.785371023388317
    # U
    0.0847478248037573-0.02624985705778860.0118544154577742-0.0267016207522752
    # Q
    0.1089816650213360.1508558230555160.1898557306774390.138272221344484
    # H
    0.00212569804819625-0.0003104481550974820.0009482126890654060.00102597509422836
    0.0008007827702850790.0006776172871035990.000704231911171150.000778897072760653
    -0.0006820232489525730.0006538809545706060.000872068445231712-0.000682421393917689
    0.0009660134228590420.001128717971568580.0009598378349677230.00118698263107226
    0.00156353540645325
    # lambda1, lambda2
    1.053034339982210.538730960886413
)
 
#------------------------------------------------
# estimation by numerical optimization
#------------------------------------------------
m<-optim(init_par, AFNSS.objf, control=list(maxit=3000,trace=2),
         method=c("Nelder-Mead"))
prev_likev <- m$value; i <- 1
repeat { 
    print(paste(i,"-th iteration"))
    m<-optim(m$par,AFNSS.objf,control=list(maxit=3000,trace=2),
             method=c("Nelder-Mead")) 
    if (abs(m$value - prev_likev) < 1e-4) break
    prev_likev <- m$value; i <- i + 1
}
 
#------------------------------------------------
# estimated parameters and log-likelihood value
#------------------------------------------------
AFNSS.trans(m$par)
AFNSS.objf(m$par)
 
cs


The log-likelihood is estimated at 30932, and parameters are estimated as appropriate values.

> 
> #------------------------------------------------
> # estimated parameters and log-likelihood value
> #------------------------------------------------
> AFNSS.trans(m$par)
 [1]  1.434196e-01  6.228329e-01  1.663590e+00  7.853710e-01
 [5]  8.474782e-02 -2.624986e-02  1.185442e-02 -2.670162e-02
 [9]  1.187700e-02  2.275748e-02  3.604520e-02  1.911921e-02
[13]  4.518592e-06  9.637806e-08  8.991073e-07  1.052625e-06
[17]  6.412530e-07  4.591652e-07  4.959426e-07  6.066806e-07
[21]  4.651557e-07  4.275603e-07  7.605034e-07  4.656990e-07
[25]  9.331819e-07  1.274004e-06  9.212887e-07  1.408928e-06
[29]  2.444643e-06  1.399112e+00  2.902310e-01
> AFNSS.objf(m$par)
          [,1]
[1,] -30932.58
> 
cs


Filtered estimates of yield curve factors are as follows:



As a reference, the estimated DNSS model shows the following yield curve factors with a log-likelihood value of 30896.




Reference


Christensen, J. H. E., F. X. Diebold, and G. D. Rudebusch (2009) An arbitrage-free generalized Nelson-Siegel term structure model, Econometrics Journal 12-3, 33–64.
Christensen, J. H. E., F. X. Diebold, and G. D. Rudebusch (2011) The affine arbitrage-free class of Nelson–Siegel term structure models, Journal of Econometrics 164-1, 4–20.
Diebold, F. X. and C. Li (2006) Forecasting the term structure of government bond yields, Journal of Econometrics 130-2, 337–364.
Diebold, F. X., G. D. Rudebusch, and S. B. Aruoba (2006) The macroeconomy and the yield curve: A dynamic latent factor approach, Journal of econometrics 131-1, 309–338.
Nelson, C. R. and A. F. Siegel (1987) Parsimonious modeling of yield curves, The Journal of Business 60-4, 473–489.
Svensson, L. E. O. (1995) Estimating forward interest rates with the extended Nelson–Siegel method, Sveriges Riksbank, Quarterly Review 3, 13–26.



No comments:

Post a Comment