R/4_financialFunctions.R

In lifecontingencies: Financial and Actuarial Mathematics for Life Contingencies

#############################################################################
#   Copyright (c) 2022 Giorgio A. Spedicato
#
#   This program is free software; you can redistribute it and/or modify
#   it under the terms of the GNU General Public License as published by
#   the Free Software Foundation; either version 2 of the License, or
#   (at your option) any later version.
#
#   This program is distributed in the hope that it will be useful,
#   but WITHOUT ANY WARRANTY; without even the implied warranty of
#   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#   GNU General Public License for more details.
#
#   You should have received a copy of the GNU General Public License
#   along with this program; if not, write to the
#   Free Software Foundation, Inc.,
#   59 Temple Place, Suite 330, Boston, MA 02111-1307, USA
#
#############################################################################
###
###         financial functions
###


#TO DO: check here http://www.mysmu.edu/faculty/yktse/FMA/S_FMA_1.pdf
#TO DO: add k to increasing and decreasing annuities function

#function to evaluate the present value of a series of cash flows
presentValue<-function(cashFlows, timeIds, interestRates, probabilities, power=1)
{
	out<-0
	if(missing(timeIds)) #check coherence on time id vector
	{	warning("Warning: missing time vector")
		timeIds=1
	}
	if(missing(probabilities)) #if no probabilities given than prob=1
	{
		probabilities <- rep(1,length(cashFlows))
	} else {
		if(length(cashFlows)!=length(probabilities)) stop("Error! Probabilities must have same length of cash flows")
	}
	
	if(!(length(cashFlows)==length(timeIds))) stop("Error! check dimensionality of cash flow and time ids vectors") #check dimensionality of cash flows
	if((length(interestRates)>1)&(length(interestRates)!=length(timeIds))) warning("Interest rates incoherent with time ids") #check dimensioanlity of time ids
	
	interestRates <- rep(interestRates,length.out=length(timeIds))
	v <- (1+interestRates)^(-timeIds)
	
	#power used for APV, usually=1
	out <- sum( ( (cashFlows^power) * (v^power) ) * probabilities) 
  #using Rcpp code seems inefficient
# 	out<-switch(calculation,
#               R=sum(((cashFlows^power)*(v^power))*probabilities),
#               Rcpp=.mult3sum(x=(cashFlows^power),y=(v^power),z=probabilities))
	return(out)
}




#' Compute the duration or the convexity of a series of CF
#'
#' @param cashFlows A vector representing the cash flows amounts. 
#' @param timeIds Cash flows times
#' @param i APR interest, i.e. nominal interest rate compounded m-thly.
#' @param k Compounding frequency for the nominal interest rate.
#' @param macaulay Use the Macaulay formula
#' @references Broverman, S.A., Mathematics of Investment and Credit (Fourth Edition), 2008, ACTEX Publications.
#' @details The Macaulay duration is defined  as 
#' \eqn{\sum\limits_t^{T} \frac{t*CF_{t}\left( 1 + \frac{i}{k} \right)^{ - t*k}}{P}}, 
#' while  \eqn{\sum\limits_{t}^{T} t*\left( t + \frac{1}{k} \right) * CF_t \left(1 + \frac{y}{k} \right)^{ - k*t - 2}}

#'
#' @return A numeric value representing either the duration or the convexity of the cash flow series
#' @export
#'
#' @examples
#' #evaluate the duration/convexity of a coupon payment
#' cf=c(10,10,10,10,10,110)
#' t=c(1,2,3,4,5,6)
#' duration(cf, t, i=0.03)
#' convexity(cf, t, i=0.03)
duration<-function(cashFlows, timeIds,i, k=1,macaulay=TRUE)
{
  out=0
  if(missing(timeIds)) #check coherence on time id vector
  {	warning("Warning: missing time vector")
    timeIds=1
  }
  
  if(!(length(cashFlows)==length(timeIds))) stop("Error! check dimensionality of cash flow and time ids vectors") #check dimensionality of cash flows
  
  interestRates<-rep(i/k,length.out=length(timeIds))
  #computing present value
  ts=timeIds*k
  v=(1+interestRates)^-(ts)
  pv<-sum((cashFlows*v))
  #pv=.C("add2", x=as.double(cashFlows), y=as.double(v),n=as.integer(length(cashFlows)),out=numeric(1))$out
  #computing weighted time
  weightedTime <- sum((cashFlows*v*ts))
  #weightedTime=.C("add3", x=as.double(cashFlows), y=as.double(v),z=as.double(ts),n=as.integer(length(cashFlows)),out=numeric(1))$out
  out <- weightedTime/pv	
  # if(macaulay==FALSE) out=out else out=out/(1+i/k) 
  # return(out)
  if (macaulay == TRUE)
    out <- out
  else 
    out <- out/(1 + i/k)
  return(out)
}


#convexity


#' @rdname duration
convexity=function(cashFlows, timeIds,i,k=1)
{
	out=0
	if(missing(timeIds)) #check coherence on time id vector
	{	warning("Warning: missing time vector")
		timeIds=1
	}
	
	if(!(length(cashFlows)==length(timeIds))) stop("Error! check dimensionality of cash flow and time ids vectors") #check dimensionality of cash flows
	
	interestRates=rep(i/k,length.out=length(timeIds))
	#calcola il valora attuale
	v=(1+interestRates)^-(timeIds*k)
	pv=sum((cashFlows*v))
	#pv=.C("add2", x=as.double(cashFlows), y=as.double(v),n=as.integer(length(cashFlows)),out=numeric(1))$out
	#calcola il tempo medio ponderato
	
	weightedTime=sum((cashFlows*v*timeIds*(timeIds+1/k)))
	#weightedTime=.C("add3", x=as.double(cashFlows), y=as.double(v),z=as.double(timeIds*(timeIds+1/k)),n=as.integer(length(cashFlows)),out=numeric(1))$out
	
	out=(weightedTime/pv)*(1+i/k)^-2
	
	return(out)
}

#annuity function
annuity=function(i, n,m=0,k=1, type="immediate")
{
	#checks
	if(missing(i)) stop("Error! Missing effective interest rates") 
	if(missing(n)) stop("Error! Missing periods")
	if(m<0) stop("Error! Negative deferring period") 
	if(k<1) stop("Error! Payment frequency must be greater or equal than 1") 
  type <- testpaymentarg(type)
	
	if(is.infinite(n)) {
		out=ifelse(type=="immediate",1/i,1/interest2Discount(i))
		return(out)
	} 
	
	if(n==0) return(0)
	ieff=i #i ? il tasso effettivo
	if(type=="immediate") timeIds=seq(from=1/k, to=n, by=1/k)+m
	else timeIds=seq(from=0, to=n-1/k, by=1/k)+m #due
	
	iRate=rep(ieff,length.out=n*k)
	out=presentValue(cashFlows=rep(1/k,length.out=n*k),interestRates = iRate, 
			timeIds=timeIds)
	return(out)
}

#decreasing annuity
decreasingAnnuity=function(i, n,type="immediate")
{
	out=NULL
	if(missing(n)) stop("Error! Need number of periods")
	if(missing(i)) stop("Error! Need interest rate")
	type <- testpaymentarg(type)
	
	paymentsSeq=numeric(n)
	timeIds=numeric(n)
	paymentsSeq=seq(from=n, to=1,by=-1)
	timeIds=seq(from=1, to=n, by=1)
	if(type=="due") 
	{
		timeIds=seq(from=0, to=n-1,by=1)
	}
	out=presentValue(cashFlows=paymentsSeq, timeIds=timeIds, interestRates=i)
	
	return(out)
}
#increasing annuity
increasingAnnuity=function(i, n,type="immediate")
{
	out=NULL
	if(missing(n)) stop("Error! Need periods")
	if(missing(i)) stop("Error! Need interest rate")
	type <- testpaymentarg(type)
	
	paymentsSeq=numeric(n)
	paymentsSeq=seq(from=1, to=n,by=1)
	timeIds=seq(from=1, to=n, by=1)
	if(type=="due") 
		{
			timeIds=seq(from=0, to=n-1,by=1)
		}
	out=presentValue(cashFlows=paymentsSeq, timeIds=timeIds, interestRates=i)
#	out=(annuity(i=i, n=n, type="due")-n*(1+i)^-n)/i
#	if(type=="due") out=out*(1+i)
	return(out)
}

Isn=function(i,n,type="immediate"){
	out=NULL
	out=(1+i)^n*increasingAnnuity(i=i,n=n,type=type)
	return(out)
}

accumulatedValue=function(i, n, m=0,k=1, type="immediate")
{
	if(is.infinite(n)) return(1/i)
	if(missing(i)) stop("Error! Missing interest rates")
  type <- testpaymentarg(type)
  
#	if(type=="immediate") timeIds=seq(from=1, to=n, by=1)
#	else timeIds=seq(from=0, to=n-1, by=1) #due
#	timeIds=-timeIds
#	iRate=rep(i,length.out=n)
#	out=presentValue(cashFlows=rep(1,length.out=n),i = iRate, timeIds=timeIds)
	out=(1+i)^n*annuity(i=i,n=n,k=k,m=m,type=type)
	return(out)
}

#' @rdname nominal-real-convertible
#' @aliases convertible2Effective
#' @aliases real2Nominal
#' @aliases nominal2Real
#' @title Functions to switch from nominal / effective / convertible rates
#'
#' @param i The rate to be converted.
#' @param k The original / target compounting frequency.
#' @param type Either "interest" (default) or "nominal".
#' 
#' @details \code{effective2Convertible} and \code{convertible2Effective} wrap the other two functions.
#'
#' @return A numeric value.
#' @references Broverman, S.A., Mathematics of Investment and Credit (Fourth Edition), 2008, ACTEX Publications.
#' @note Convertible rates are synonims of nominal rates
#' @seealso \code{\link{real2Nominal}}
#'
#' @examples
#' #a nominal rate of 0.12 equates an APR of
#' nominal2Real(i=0.12, k = 12, "interest")
#' @export
nominal2Real=function(i, k=1, type="interest")
{
	out <- NULL
	if(type=="interest") 
	  out <- (1+i/k)^k-1 
	else 
		out<- 1-(1-i/k)^k
	return(out)
}
#' @rdname nominal-real-convertible
#' @export
convertible2Effective=function(i, k=1, type="interest")
{
	return(nominal2Real(i=i,k=k,type=type))
}
#' @rdname nominal-real-convertible
#' @export
real2Nominal=function(i, k=1, type="interest")
{
	if(type=="interest") out=((1+i)^(1/k)-1)*k else
		out=k*(1-(1-i)^(1/k))
	return(out)
}
#' @rdname nominal-real-convertible
#' @export
effective2Convertible=function(i, k=1, type="interest")
{
	return(real2Nominal(i=i,k=k,type=type))
}


#' @title Functions to switch from interest to intensity and vice versa.
#' @description There functions switch from interest to intensity and vice - versa.
#' @rdname intensity-interest
#' @aliases interest2Intensity
#'
#' @param intensity Intensity rate
#' @details Simple financial mathematics formulas are applied.
#' @references Broverman, S.A., Mathematics of Investment and Credit (Fourth Edition), 2008, ACTEX Publications.
#' @author Giorgio A. Spedicato
#' @seealso \code{\link{real2Nominal}}, \code{\link{nominal2Real}} 
#'
#' @return A numeric value.
#'
#' @examples
#' # a force of interest of 0.02 corresponds to an APR of 
#' intensity2Interest(intensity=0.02)
#' @export
intensity2Interest=function(intensity)
{
	out=exp(intensity*1)-1
	return(out)
}
#' @rdname intensity-interest
#' @param i interest rate
#' @examples
#' #an interest rate equal to 0.02 corresponds to a force of interest of of 
#' interest2Intensity(i=0.02)
#' @export
interest2Intensity=function(i)
{
	out=log(1+i)
	return(out)
}

#convert the interest to discount
interest2Discount=function(i)
{
	return(i/(1+i))
}

#convert the discount to interest
discount2Interest=function(d)
{
	return(d/(1-d))
}