#' keyrate duration function
#'
#' Calculates keyrate duration of a bond
#'
#' @author wkapga
#'
#' @param keyrates list of keyrates
#'
#' @param ttm time until maturity in years
#' @param coupon in percent
#' @param yield in percent
#' @param freq frequency of coupon payments
#' @param targetdur optional argument what the sum of keyrate durations has to be
#'
#' @return tibble of key rate durations
#' @export
#'
#' @importFrom purrr map_dfc map_dbl %>% flatten_dbl
#' @importFrom tibble as.tibble tibble
#' @importFrom utils head tail
#'
#' @examples
#'\dontrun{
#' keydur(c(2,5,10),6.2,1,2,1)
#' }
keydur <- function(keyrates,ttm,coupon,yield,freq,targetdur= NULL) {
# add keyrate at 0 and far in future
keyrates_expanded <- c(0, keyrates , (tail(keyrates,1)+10) *100 )
# list of occurence of cashflow in time
tt <- seq((ttm*freq - floor(ttm*freq))/freq, ttm, by = 1/freq )
# list of value of cash flows
cf <- rep(coupon/freq/100, length(tt)) + c( rep(0, length(tt)-1), 1)
# discounted cash flows
dcf <- cf * ( 1 + yield / 100 ) ^ (-tt)
# duration per cash flow, total duration would be sum(vec)
vec <- dcf * tt / sum( dcf )
# get matrix of weights
kw <- map_dfc( tt, ~ as.tibble(wg(keyrates_expanded, .x ) ) )
# matrix multiplication
k <- as.matrix( kw ) %*% as.matrix( vec ) %>% as.tibble %>% flatten_dbl()
# add keyrate at zero to first keyrate and add keyrate far in future to last keyrate
k <- c(sum(head(k,2)), k[3:(length(k)-2)], sum( tail(k,2)) )
# use stated duration if given
if ( ! is.null(targetdur) ) { k <- k * targetdur/sum(k) }
return( tibble( kr = keyrates, val=k ) )
}
#' wg helper function
#'
#' @param keyrates vector of keyrates
#' @param tt time of cash flow to attribute to keyrates
#'
#' @return a list of weights with length of keyrates, sum = 1
#' @export
#'
#' @examples
#'\dontrun{
#' wg(c(2,5,10),6.2)
#' }
wg <- function (keyrates,tt) {
# list of zeros length of keyrates
w <- keyrates * 0
# find index of first keyrate > tt
i <- min(which(keyrates > tt))
# alternative:
# i <- keyrates %>% detect_index(~ (.x > tt) )
#assign percentages
w[i] <- (tt-keyrates[i-1] )/ (keyrates[i] - keyrates[i-1])
w[i-1] <- 1 - w[i]
return(unlist(w))
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.