R/cashFlows.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
#*******************************************************************************

##############################################################
#' \code{cashFlows}
#'
#' Function that returns the cashflows generated by object \code{x} in form of
#' a \code{\link{timeSeries}} object.
#' 
#' @param x The contract for which to calculate cashflows
#' 
#' @param from Start date of cashflow calculation
#'
#' @param to End date of cashflow calculation
#' 
#' @param riskfactors Object of type \code{YieldCurve} or 
#'  \code{RiskfactorConnector} 
#' 
#' @return timeSeries of generated cashflows 
#' 
#' @usage cashFlows(x, from, to, riskfactors)
#' 
#' @examples
#' my.account <- bankAccount("2013-12-31", balance = 50000)
#' cashFlows(my.account, from = "2013-01-01", to = "2019-01-01")
#' 
#' @include RiskFactorConnector.R Events.R
#' @export 
cashFlows <- function(x, from=NULL, to=NULL, riskfactors=NULL, variableRate=data.frame()) {

  if (class(x)=="Portfolio") {
    # is this a portfolio, this case is not properly handled yet...
    cts <- FEMS:::get(x, "contracts")
    cfs <- cashFlows(cts[[1]], from)
    for(i in 2:length(cts)) cfs=rbind(cfs, cashFlows(cts[[i]], from))
    colnames(cfs) <- c("Value", "Time")
    return(cfs)
  } else if (any(is(x) %in% c("Operations", "CurrentAccount"))) {
    
    # for FEMS Contracts like Operations and CurrentAccount, the setup is different
    
    # potentially get risk factor out of the contract, if it is provided
    if(is.null(riskfactors)) {
      rf_conn <- FEMS:::get(x, "RiskFactorConnector")$RiskFactorConnector
      if (identical(rf_conn$riskfactors, list())) {
        riskfactors <- NULL
      }
    }
    
    # set from to the contract deal date if not provided
    if(is.null(from)) {
      from <- as.character(FEMS:::get(x, "ContractDealDate"))
      if(is.null(from)){
        stop("Argument 'from' has to be provided !!!")
      }
    }
    
    # for both contracts, there is no maturity date, take to from actual events already calculated with OPS
    # take to to be from plus 5 years for current accounts and print a message...
    if(is.null(to)) {
      if (any(is(x) %in% c("Operations"))) {
        if (is.null(riskfactors)) {
          eS <- events(x, from)
        } else {
          eS <- events(x, from, riskfactors)
        }
        to <- eS$evs$Date[length(eS$evs$Date)]
      } else {
        # use 5 years after ContractDealDate
        print("No end date specified. Default of 5 years from start date is used !")
        to <- as.character(ymd(from) %m+% years(5))
      }
    }
    
  } else {
  
    if(FEMS:::get(x, "CycleOfRateReset")!="NULL") { # && ncol(variableRate)==0) {
      stop("'x' is a variable rate instrument, hence, please provide 'variableRate' information (a trajectory of the variable rate process)!")
    }
    if(is.null(from)) {
      from <- as.character(FEMS:::get(x, "InitialExchangeDate"))
    }
    if(is.null(to)) {
      to <- as.character(FEMS:::get(x, "MaturityDate"))
    }
  
    if(is.null(riskfactors)) {
      riskfactors <- FEMS:::get(x, "RiskFactorConnector")
    }
  }
  
  # check if riskfactors is just a yieldcurve, if so, convert this to RFConn
  if (is(riskfactors,"YieldCurve")) {
    riskfactors <- RFConn(riskfactors)
  } else if (!is.null(riskfactors) & !is(riskfactors,"RiskFactorConnector")) {
    stop("Argument 'riskfactors' must either be of type 'YieldCurve' or 'RiskfactorConnector' !!!")
  }

  if (is.null(riskfactors)) {
    if ((class(x)=="CurrentAccount")){
      eS <- events(x, from, end_date = to)
    } else {
      eS <- events(x, from)
    }
  } else {
    if ((class(x)=="CurrentAccount")){
      eS <- events(x, from, riskfactors, end_date = to)
    } else {
      eS <- events(x, from, riskfactors)
    }
  }

  cf <- as.data.frame(eS)[,c("Date","Value","Type","Time")]
  cf <- cf[cf$Date>=from,]
  cf <- cf[cf$Date<=to,]
  #cf[cf$Type%in%c("RR","RRY","SC","PRY"),"Value"] <- 0
  cf <- cf[!(cf$Type%in%c("IPCI","DPR","PRF","RR","RRY","SC","PRY")),]
  cf <- cf[!((cf$Type %in% "AD0") & (cf$Value==0)),]
  # return 0 if nothing is there...
  if (dim(cf)[1]==0) {
    ts <- timeSeries(cbind(0,0), 
                     charvec = from, 
                     units = c("Value","Time"))
    return(ts)
  }
  
  if (cf$Type[dim(cf)[1]]!="MD" & cf$Value[dim(cf)[1]]==0){
    cf <- cf[1:dim(cf)[1]-1,]
  }
  cf.ts <- timeSeries(cf[,c("Value","Time")], charvec=substring(cf$Date,1,10))
  cf.ts$Time <- as.numeric(cf.ts$Time)
  cf.ts$Value <- as.numeric(cf.ts$Value)
  ts <- aggregate(cf.ts, time(cf.ts), "sum")
  ts$Time <- cf.ts[row.names(ts),]$Time
  return(ts)
}