# R/ptools_annuity_functions.r In donboyd5/ptools: Tools for simulation modeling of pension funds

#### Documented in get_PVFBget_tlaget_tla2get_tla2a

```#' @title Calculate temporary annuity values from age x to retirment age (fixed end)
#'
#' @description \code{get_tla} present value of annuity-immediate
#' @usage get_tla(px, i, scale, cashflow)
#' @param px a vector of composite survivial probs from age x to x + n - 1. Length = n
#' @param i discount rate, scalar
#' @param scale numeric vector of length px
#' @param cashflow The cashflow of the annuity can be specified by this argument. This is useful when calculating PV of benefits with COLA.
#' @details  Suppose the age corresponding to px runs from a1 to aN, and f = aN + 1 (eg. age 30:64, f = 65)
#' The function computes a..{x, f - x} and s_a..{x, f - x}, x runing from a1 to aN.
#' The length of px is f - a1
#' Note that the last element is redundant, just used as a place holder.

#' @return an n vector storing the value of temporary life annuities from age x to age x + n - 1
#' @keywords get_tla
#' @export
#' @examples
#' get_tla(rep(0.98, 55), 0.08)
get_tla <- function(px, i, scale = rep(1, length(px)), cashflow = rep(1, length(px))){
# suppose the age corresponding to px runs from a1 to aN, and f = aN + 1 (eg. age 30:64, f = 65)
# The function computes a..{x, f - x} and s_a..{x, f - x}, x runing from a1 to aN.
# The length of px is f - a1
# Note that the last element is redundant, just used as a place holder.

# inputs:
# px: an vector of composite survivial probs from age x to x + n - 1. Length = n
# i:  discount rate, scalar
# scale: how the annuity scale up over time. eg:
#        1) salary scale. default is a n vector of 1, meaning no salary scale. used when calculating career based annuity
#        2) simple COLA scale: COLA increasing at a fixed percentage very year.
# cashflow: The cashflow of the annuity can be specified by this argument. This is useful when calculating PV of benefits with COLA.
# output:
# tla: an n vector storing the value of temporary life annuities from age x to age x + n - 1.
tla <- numeric(length(px))
n <- length(tla)

for(j in 1:n){
v   <- 1/(1 + i)^(0:(n - j)) # dicount vector
if(j < n) pxr <- cumprod(c(1, px[j:(n - 1)])) else pxr = 1      # survival probability to retirment at age x. Note that participant always survives at the beginning of age x
SS  <- scale[j:n]/scale[j]                # scale
tla[j] = sum(SS * v * pxr)                # computing annuity value at j
}
return(tla)
}

#' @title Calculate temporary annuity values from a fixed entry age y to x (fixed start)
#'
#' @description \code{get_tla2} present value of annuity-immediate
#' @usage get_tla2(px, i, sx)
#' @param px a vector of composite survivial probs from age x to x + n - 1. Length = n
#' @param i discount rate, scalar
#' @param sx salary scale. default is an n vector of 1, meaning no salary scale.
#' @details  Suppose the age corresponding to px runs from a1 to aN, y = a1 (eg. age 30:65, y = 30)
#' This function conputes a..{y, x - y} and s_a..{y, x - y}, x ruuning from a1 to aN.
#'
#' Note that when x = a1 = y, we define a..{y, 0} = 0. so the first element is always 0.
#' For age x > y, the number of years receiviing annuity is x - y, the resulting annuity value will be placed at age x.
#' eg1: x = 31, y = 30,  annuity (\$1) received only once at age 30, but the resulting annuity value will be placed at age 31.
#' eg2: x = 65, y = 30, annuity received from age 30 to 64(total 65 years), the resulting annuity value will be placed at age 65
#'
#' Note that the last 2 survival rates and last salary scale are redundant in the calculation, they are just used as place holders.
#' calculating the value of annuity running from 30 to 64 only involves survival rate from 30 to 63,
#' because the last annuity payment is paid at the begining of 64. )
#' @return an n vector storing the value of temporary life annuities from age x to age x + n - 1.
#' @keywords get_tla2
#' @export
#' @examples
#' get_tla2(rep(0.98, 65), 0.08, rep(1.1, 65))
get_tla2 = function(px, i, sx = rep(1, length(px))){
# Suppose the age corresponding to px runs from a1 to aN, y = a1 (eg. age 30:65, y = 30)
# This function conputes a..{y, x - y} and s_a..{y, x - y}, x ruuning from a1 to aN.

# Note that when x = a1 = y, we define a..{y, 0} = 0. so the first element is always 0.
# For age x > y, the number of years receiviing annuity is x - y, the resulting annuity value will be placed at age x.
# eg1: x = 31, y = 30,  annuity (\$1) received only once at age 30, but the resulting annuity value will be placed at age 31.
# eg2: x = 65, y = 30, annuity received from age 30 to 64(total 65 years), the resulting annuity value will be placed at age 65
# Note that the last 2 survival rates and last salary scale are redundant in the calculation, they are just used as place holders.
#(calculating the value of annuity running from 30 to 64 only involves survival rate from 30 to 63,
# because the last annuity payment is paid at the begining of 64. )

# inputs:
# px: an vector of composite survivial probs from age x to x + n - 1. Length = n. The minimum length of px allowed is 2.
# i:  discount rate, scalar
# sx: salary scale. default is an n vector of 1, meaning no salary scale.
# output:
# tla: an n vector storing the value of temporary life annuities from age x to age x + n - 1.
tla = numeric(length(px))
n = length(tla)

# tla[1] will be kept as 0, next calculate tla[2:n]:
for(j in 1:(n - 1)){
v   <- 1/(1 + i)^(0:(j - 1))                                  # dicount vector
if(j == 1) pxr <- 1 else pxr <- cumprod(c(1, px[1:(j - 1)]))  # survival probability to retirment at age x. Note that participant always survives at the beginning of age x
SS  <- sx[1:j]/sx[1]                                          # salary scale
tla[j + 1] = sum(SS * v * pxr)                                # computing annuity value at j;
}
return(tla)
}

#' @title Calculate temporary annuity values from a fixed entry age y to x (fixed start), simpler implementation
#'
#' @description \code{get_tla2a} present value of annuity-immediate
#' @usage get_tla2a(px, i, sx)
#' @param px a vector of composite survivial probs from age x to x + n - 1. Length = n
#' @param i discount rate, scalar
#' @param sx salary scale. default is an n vector of 1, meaning no salary scale.
#' @details  Suppose the age corresponding to px runs from a1 to aN, y = a1 (eg. age 30:65, y = 30)
#' This function conputes a..{y, x - y} and s_a..{y, x - y}, x ruuning from a1 to aN.

#' Note that when x = a1 = y, we define a..{y, 0} = 0. so the first element is always 0.
#' For age x > y, the number of years receiviing annuity is x - y, the resulting annuity value will be placed at age x.
#' eg1: x = 31, y = 30,  annuity (\$1) received only once at age 30, but the resulting annuity value will be placed at age 31.
#' eg2: x = 65, y = 30, annuity received from age 30 to 64(total 65 years), the resulting annuity value will be placed at age 65
#' Note that the last 2 survival rates and last salary scale are redundant in the calculation, they are just used as place holders.
#' calculating the value of annuity running from 30 to 64 only involves survival rate from 30 to 63,
#' because the last annuity payment is paid at the begining of 64. )

#' @return an n vector storing the value of temporary life annuities from age x to age x + n - 1.
#' @keywords get_tla2a
#' @export
#' @examples
#' get_tla2a(rep(0.98, 65), 0.08, rep(1.1, 65))
#' get_tla2(rep(0.98, 65), 0.08, rep(1.1, 65))
get_tla2a <- function(px, i, sx = rep(1, length(px))){

n <- length(px)
tla <- numeric(n)
v <- 1/(1 + i)

tla[-1] <- cumsum(cumprod(c(1,px[1:(n-2)])* v * sx[1:(n - 1)]/sx[1])/v)

return(tla)
}

#' @title PVFB of term costs
#'
#' @description \code{get_PVFB} present value of annuity-immediate
#' @usage get_PVFB(px, v, TC)
#' @param px numeric vector of length n. Probability of survival at time 1 through n
#' @param v numeric. discount factor 1/(1 + i)
#' @param TC numeric vector of length n. A series of term costs. Term costs are valued at the begninning of period.
#' @details Returns a POSITIVE present value for positive payment
#' @return vector length n, with PVFBs of fixed end contracting windows of TC
#' @keywords get_PVFB
#' @export
#' @examples
#' get_PVFB(.9^(1:20), 1/(1.08), 10*(1.03)^(1:20))
get_PVFB <- function(px, v, TC){ # present values of subsets of TC (fixed end)
# This function compute the total present value of TC[j:n] at the beginning of time j, with j running from 1 to n.
# The function can be used to calculate PVFB of term costs of ancillary benefits or retirement benefits with multiple
# retirement ages.

# Inputs
# px: numeric vector of length n. Probability of survival at time 1 through n
# v : numeric. discount factor 1/(1 + i)
# TC: numeric vector of length n. A series of term costs. Term costs are valued at the begninning of period.
# Returns
# PVFBs of fixed end contracting windows of TC.

n <- length(px)

PVFB <- sapply(seq_len(n), function(j) ifelse(j == n, TC[j], sum(cumprod(c(1, (px[j:(n - 1)] * v))) * TC[j:n])))

return(PVFB)
}

# # 1.4 NC of UC and PUC
# #' @title Present value of an annuity-immediate (with pmt at end of period)
# #'
# #' @description \code{pvann} present value of annuity-immediate
# #' @usage pvann(i, n, pmt)
# #' @param i interest rate
# #' @param n number of periods
# #' @param p periodic payment
# #' @details Returns a POSITIVE present value for positive payment
# #' @return The initial payment
# #' @keywords pvann
# #' @export
# #' @examples
# #' pvann(.05, 30, 100000)
# get_NC.UC <- function(px, v, TC){
#   # This function is a variation of get_PVFB. It is used to calculate NC under UC and PUC methods.
#   # Below we explain the major difference between get_NC.UC and get_PVFB:
#   # 1. Why TC[(j + 1):n]?  Remember NC is the discounted value of benefit accrual. During age x, the individual can
#   #    accrue benefit for age x + 1 to r'', so the corresponding elements in TC are TC[(j + 1):n]. Note that
#   #    TC[j+1] is gx.r(j+1)*qxr(j+1)*ax(j+1) in PUC.
#   # 2. Why start discounting from the 1st element? Since at j the individual starts accruing benefit from j + 1,
#   #    we need to discount the value in j + 1.
#   # Note The last elements (at age r'') of the result is NA by construction.
#   # px must be survival probability from min(age) to r''.
#   # TC must be defined as
#   #  UC for retirement:    gx.r(x) * qxr(x) * ax(x), x running from y (entry age) to r'' (eg. 20 to 65 in Winklevoss book)
#   #  PUC for retirement:   Bx(x)/(x - y) * gx.r(x) * qxr(x) * ax(x), x running from entry age (y) to r'' (0 when x = y)
#   #  PUC for vested terms: Bx(x)/(x - y) * gx.r(x) * qxt.a * lead(pxRm) * v^(r.max - age) * ax[age == r.max]
#   n <- length(px) # n is r''
#
#   Fun_NC <- function(j) ifelse(j == n, NA, sum(cumprod(px[j:(n - 1)]) * v^(1:(n-j)) * TC[(j + 1):n]))
#
#   NC <- sapply(seq_len(n), Fun_NC)
#
#   return(NC)
# }
#
# # 1.5 AL of PUC
# #' @title Present value of an annuity-immediate (with pmt at end of period)
# #'
# #' @description \code{pvann} present value of annuity-immediate
# #' @usage pvann(i, n, pmt)
# #' @param i interest rate
# #' @param n number of periods
# #' @param p periodic payment
# #' @details Returns a POSITIVE present value for positive payment
# #' @return The initial payment
# #' @keywords pvann
# #' @export
# #' @examples
# #' pvann(.05, 30, 100000)
# get_AL.PUC <- function(px, v, TC){
#   # This function is a variation of get_PVFB. It is used to calculate AL under PUC methods.
#
#   # Note that the only difference between get_AL.PUC and get_PVFB is that TC[j] is multiplied by (j - 1)
#
#   # Note that y(entry age) corresponds to index 1 and age x corresponds to index j, so at age x the individual
#   # has been accruing benefits for x - y years, which is equal to j - 1 years. (eg. Assuming y = 20, then when x = 21 and j = 2 the
#   # individual have accrued benefits for 1 year (x - y = 21 - 20 and j - 1 =  2 - 1).
#
#   # TC must be defined the same way as in get_NC.UC.
#   # the first element (age y) should be zero, the last element should be the same as the last element in TC.
#
#   n <- length(px) # n is r'' - y + 1
#   AL <- sapply(seq_len(n),
#                function(j) ifelse(j == n, TC[j]*(j-1), sum(cumprod(c(1, (px[j:(n - 1)] * v))) * TC[j:n] * (j - 1)))
#   )
#   return(AL)
# }
```
donboyd5/ptools documentation built on May 13, 2017, 4:34 a.m.