R/presentValue.R

In wbreymann/FEMS: R Package for Financial Enterprise Modelling and Simulation

#*******************************************************************************
# ZHAW Risk and Finance Lab
# package: rflContracts
# Date: 14.09.2015
# IDP - Institute for Data Analysis and Process Design
# author(s): Nils Andri Bundi (bund@zhaw.ch)
#*******************************************************************************

##############################################################
#' \code{presentValue}
#'
#' Function that calculates the Net Present Value (NPV) for the cash flow streams 
#' generated by or contained in object \code{x}.
#' 
#' @param x a contract type, for which to calculate the NPV. This can also be 
#'          a timeSeries, EventSeries or Portfolio object.
#' 
#' @param yield a numeric, an object of type \code{\link{YieldCurve}} or 
#'                    \code{\link{DynamicYieldcurve}} to calculate discount 
#'                    factors from, indicating the percentage yield used to discount.
#'
#' @param by a character indicating the date as for which the NPV is calculated.
#'  
#' @param isPercentage a logical, indicating if the 'yield' is passed as percentage 
#'                     (TRUE) or as fraction (FALSE) (default is TRUE). 
#'                     
#' @param isPrice a logical indicating whether the result should be a price
#'                in the case of a cash flow pattern where the initial cash flow
#'                is negative and the others are positive (default is FALSE).   
#'                
#' @param digits an integer indicating the number of digits to round to. (default is 2)          
#' 
#' @return a numeric, representing the Net Present Value (NPV) of the contract. 
#' 
#' @usage presentValue(x, yield, by, isPercentage, isPrice, digits)
#' 
#' @details 
#' TO BE ADDED
#' 
#' @examples
#' b <- bond("2013-12-31", maturity = "5 years", nominal = 50000, 
#'            coupon = 0.02, couponFreq = "1 years")
#' npv <- presentValue(b, yield = 2) # result: 0 due to same coupon as yield
#' evs <- events(b, "2013-12-31")
#' npv <- presentValue(evs, yield = 1)
#' ts <- timeSeries(data = c(-50000, 1000, 1000, 1000, 1000, 51000),
#'                  charvec = c("2013-12-31", "2014-12-31", "2015-12-31", 
#'                  "2016-12-31", "2017-12-31", "2018-12-31"),
#'                  units = "Value")
#' npv <- presentValue(ts, yield = 1)
#' 
#' @include cashFlows.R DynamicYieldCurve.R YieldCurve.R
#' @export 

presentValue <- function(x, yield,  
                         by=NULL, isPercentage=TRUE, isPrice=FALSE, digits=2, 
                         method="compound", period="Y", convention="30E360", 
                         yieldCurve=NULL) {

  if (!is.null(yieldCurve)){
    stop("Argument 'yieldCurve' deprecated, please use 'yield' instead!")
  }
  
  if(class(x)=="Portfolio") {
    cts <- FEMS:::get(x, "contracts")
    pv <- 0
    if (is.numeric(yield)){
      if(length(yield)!=length(cts)) {
        stop("Provide yieldcurve or 'yield' with lenght same as number of contracts in the Portfolio!")
      }
      for(i in 1:length(cts)) pv <- 
        pv + presentValue(cts[[i]], yield[i], by, isPercentage, isPrice, 
                          method=method, period=period, convention=convention)
      return(pv)
    } else {
      for(i in 1:length(cts)) pv <- 
          pv + presentValue(cts[[i]], yield, by, isPercentage, isPrice,
                            method=method, period=period, convention=convention)
      return(pv)
    }
  }
  
  # compute cash flows of instrument
  if (class(x)=="timeSeries") {
    if(is.null(by)) {
      by <- as.character(rownames(x)[1])
    }
    if (is(yield, "YieldCurve") || is(yield, "DynamicYieldCurve")){
      convention <- yield$DayCountConvention
    }
    #colnames(x) <- rep("Value", ncol(x))
    cf <- x
    if (!("Time" %in% colnames(cf))) {
      t <- timeSeries(data=yearFraction(rownames(cf)[1], rownames(cf), convenction=convention),
                      charvec=rownames(cf),
                      units = "Time")
      cf <- cbind(cf, t)
      cf$Time <- yearFraction(rownames(cf)[1], rownames(cf), convenction=convention)
    }
    colnames(cf)[1:ncol(cf)-1] <- rep("Value", ncol(cf)-1)
    if (isPrice && by == rownames(cf)[1]) {
      cf <- cf[2:nrow(cf),]
    }
  } else if (class(x)=="EventSeries") {
    evs <- as.data.frame(x)[,c("Date","Value","Type","Time")]
    if(is.null(by)) {
      by <- as.character(evs$evs$Date[1])
    }
    if (isPrice && evs[evs$Date==by,"Type"]=="IED") {
      evs <- evs[evs$Date>by,]
    } else {
      evs <- evs[evs$Date>=by,]
    }
    #evs[evs$Type%in%c("RR","RRY","SC","PRY"),"Value"] <- 0
    evs <- evs[!(evs$Type%in%c("IPCI","DPR","PRF","RR","RRY","SC","PRY")),]
    evs <- evs[!((evs$Type %in% "AD0") & (evs$Value==0)),]
    if (evs$Type[dim(evs)[1]]!="MD" & evs$Value[dim(evs)[1]]==0){
      evs <- evs[1:dim(evs)[1]-1,]
    }
    evs.ts <- timeSeries(evs[,c("Value","Time")], charvec=substring(evs$Date,1,10))
    evs.ts$Time <- as.numeric(evs.ts$Time)
    evs.ts$Value <- as.numeric(evs.ts$Value)
    cf <- aggregate(evs.ts, time(evs.ts), "sum")
    cf$Time <- evs.ts[row.names(cf),]$Time
  } else if (any(is(x) %in% c("CurrentAccount","Operations"))) {
    if(is.null(by)) {
      by <- as.character(FEMS:::get(x, "ContractDealDate"))
      if(is.null(by)){
        stop("Argument 'by' has to be provided !!!")
      }
    }
    if (isPrice && by == as.character(FEMS:::get(x,"ContractDealDate"))) {
      by <- as.character(ymd(by) %m+% days(1))
    }
    cf <- cashFlows(x, from=by)
  } else {
    if(is.null(by)) {
      by <- as.character(FEMS:::get(x,"InitialExchangeDate"))
    }
    if (isPrice && by == as.character(FEMS:::get(x,"InitialExchangeDate"))) {
      # Why do we add a day here if this is the same as InitialExchangeDate?
      by <- as.character(ymd(by) %m+% days(1))
    }
    cf <- cashFlows(x, from=by)
  }
  
  # compute discount factors for cash flow dates
  if(!is.numeric(yield)) {
    df <- discountFactors(yield, to=as.character(time(cf)), method = method, period = period)
  } else {
    scale <- 1
    if(isPercentage) {
      scale <- 1/100
      rates <- yield*scale
    }
    dts <- yearFraction(by, rownames(cf), convention = convention)
    if (method == "linear") {
      df <- (1 + rates*abs(dts))^sign(-dts)
    } else if (method == "compound") {
      num_period <- convert.rate.period(period)
      df <- (1 + rates/num_period)^(-dts*num_period)
    } else if (method == "continuous") {
      df <- exp(-dts * rates)
    } else {
      stop(paste("ErrorIn::presentValue:: Method ", method, 
                 " not supported !!!"))
    }
    # df <- (1+yield*scale)^(-cf$Time)
  }
  
  # compute and return present value
  out <- c()
  for (i in 1:(ncol(cf)-1)) {
    cf_temp <- cf[,c(i,ncol(cf))]
    out <- c(out, as.numeric(t(cf_temp$Value)%*%df))
  }
  return (round(out,digits))
}