R/ContractPlot.R

Defines functions getEventParameters addChildLayers addMarginingLayer addDividendLayer addRateResetLayer addInterestAccrualsLayer addCapitalisationLayer addPrincipalRedemptionLayer addInterestPaymentLayer addNotionalPrincipalPaymentLayer addNotionalPrincipalStateLayer initializeCombinedCTGraphic initializeBasicCTGraphic drawCombinedCTGraphic drawBasicCTGraphic contractPlot

#*************************************************************
# Copyright (c) 2015 by ZHAW.
# Please see accompanying distribution file for license.
#*************************************************************


##############################################################
#' Generate a graphical representation of an 
#' \code{\link{EventSeries}}
#'
#' This method generates a graphical representation of the 
#' contract events generated by an ACTUS CT. 
#' 
#' The graphical representation draws the series of contract 
#' events and indicates generated cash flows by arrows (incoming 
#' cash flows are represented by arrows pointing to the x-axis,
#' outgoing cash flows by arrows pointing away from the x-axis).
#' A color code indicates what type a certain cash flow relates 
#' to (cf. legend for further explanaitions). 
#' 
#' \code{plot} may be used with an object of one of classes 
#' \code{\link{ContractType}} \code{\link{EventSeries}}. If used
#' with an object of class \code{\link{ContractType}}, the analysis
#' date as per which events should be drawn has to be provided as 
#' argument \code{y}.
#' 
#' @param x The object carrying the contract events to be potted
#' 
#' @param y (only if \code{x} is an objecto of class 
#'        \code{\link{ContractType}}) A character giving the analysis
#'        as per which to plot contract events 
#' 
#' @param ... Additional graphical parameters.
#'
#' @return
#' 
#' @seealso \code{\link{ContractType}} and \code{\link{EventSeries}}
#'
#' @examples
#' pam = Pam()
#' set(pam, what=list(
#'                    ContractID = "001",
#'                    Currency = "CHF",
#'                    ContractRole = "RPA",
#'                    StatusDate       = "2012-12-31T00",
#'                    ContractDealDate = "2012-12-31T00",
#'                    InitialExchangeDate = "2013-01-01T00",
#'                    MaturityDate = "2013-03-31T00",
#'                    NotionalPrincipal = 1000, 
#'                    NominalInterestRate = 0.01,
#'                    DayCountConvention = "30E/360"))
#' plot(pam,"2012-12-31T00") 
#' 
## @include
#' @export
#' @docType methods
#' @rdname plt-methods
if (!isGeneric("plot"))
setGeneric(name = "plot", 
           def = function(x, y, ...) {
             standardGeneric("plot")
           })

#' @include ContractType.R
#' @include EventSeries.R
#' @export
#' @docType methods
#' @rdname plt-methods
setMethod("plot", signature("ContractType", "character"),
          definition = function(x, y, yc=NULL, ...){
            if (is(yc,"YieldCurve")){
              rf_con <- RFConn(yc)
              set(x, rf_con)
            }
            
            # extract event series as data.frame
            evs=EventSeries(x,y)
            df=as.data.frame(evs)
            
            # plot
            # I need to distinguish between single and combined contracts!
            ct <- get(evs,"ct")
            id <- get(evs,"id")
            if (tolower(ct) %in% c("future", "futur", "option", "optns")) {
              FEMS:::contractPlot(df,contractType = ct,
                                    childType =
                                      get(get(x,what="ChildContracts")[[1]], what="ContractType"),
                                    contractId = id)
              
            } else if (tolower(ct) %in% c("swap", "swaps")){
              FEMS:::contractPlot(df,contractType = ct,
                                    childType =
                                      c(get(get(x,what="ChildContracts")[[1]], what="ContractType"),
                                        get(get(x,what="ChildContracts")[[2]], what="ContractType")),
                                    contractId = id)
            } else {
              FEMS:::contractPlot(df,contractType = ct, contractId = id)
              
            }
          })


#' @include EventSeries.R FEMSContract.R
#' @export
#' @docType methods
#' @rdname plt-methods
setMethod("plot", signature("FEMSContract", "character"),
          definition = function(x, y, yc=NULL, to=NULL, ...){

            if (is(yc,"YieldCurve")){
              rf_con <- RFConn(yc)
              set(x, rf_con)
            } else {
              rf_con <- RFConn()
            }

            # extract event series as data.frame
            if ((class(x)=="CurrentAccount")) {
              if (is.null(to)){
                to <- as.character(ymd(x$ContractDealDate) %m+% years(5))
              }
              evs <- EventSeries(x, y, rf_con, end_date = to)
            } else {
              evs <- EventSeries(x, y)
            }
            df <- as.data.frame(evs)
            
            # plot
            # I need to distinguish between single and combined contracts!
            ct <- get(evs,"ct")
            id <- get(evs,"id")
            if (tolower(ct) %in% c("future", "futur", "option", "optns")) {
              FEMS:::contractPlot(df,contractType = ct,
                                  childType =
                                    get(get(x,what="ChildContracts")[[1]], what="ContractType"),
                                  contractId = id)
              
            } else if (tolower(ct) %in% c("swap", "swaps")){
              FEMS:::contractPlot(df,contractType = ct,
                                  childType =
                                    c(get(get(x,what="ChildContracts")[[1]], what="ContractType"),
                                      get(get(x,what="ChildContracts")[[2]], what="ContractType")),
                                  contractId = id)
            } else {
              FEMS:::contractPlot(df,contractType = ct, contractId = id)
              
            }
          })

#' @export
#' @docType methods
#' @rdname plt-methods
setMethod("plot", signature("EventSeries", "character"),
          definition = function(x, y, yc=NULL, ...){
            
            # extract event series as data.frame
            df <- as.data.frame(x)
            
            # plot
            # I need to distinguish between single and combined contracts!
            ct <- get(x,"ct")
            id <- get(x,"id")
            if (tolower(ct) %in% c("future", "futur", "option", "optns")) {
              FEMS:::contractPlot(df,contractType = ct,
                                  childType =
                                    get(get(x,what="ChildContracts")[[1]], what="ContractType"),
                                  contractId = id)
              
            } else if (tolower(ct) %in% c("swap", "swaps")){
              FEMS:::contractPlot(df,contractType = ct,
                                  childType =
                                    c(get(get(x,what="ChildContracts")[[1]], what="ContractType"),
                                      get(get(x,what="ChildContracts")[[2]], what="ContractType")),
                                  contractId = id)
            } else {
              FEMS:::contractPlot(df,contractType = ct, contractId = id)
              
            }
          })

# setMethod("plot", signature("ContractType", "character"),
#           definition = function(x, y, yc=NULL, ...){
#             browser()
#             if (is(yc,"YieldCurve")){
#               rf_con <- RFConn(yc)
#               set(x, rf_con)
#               plot(x, y, ...)
#             } else {
#               plot(x, y, ...)
#             }
#           })


# -----------------------------------------------------------
# private helper method (accessed through method 'plot')
contractPlot <- function(x, ...){
  
    ##require(timeSeries)
    ## get function arguments
    df <- x
    start <- substr(df[1,"Date"], 1, 10) # no time information
    end <- substr(df[nrow(df), "Date"], 1, 10)     # no time information
    by <- "1 day"
    optList <- list(...)

    contractType = optList$contractType
    contractId <- optList$contractId

    ## remove timestamp
    df$Date <- substr(df$Date, 1, 10)

    ## basic or combined ct?
    if(tolower(gsub(" ", "", contractType)) %in%
       c("pam", "principalatmaturity", "ann", "annuity",
         "nam", "negativeamortizer", "lam", "linearamortizer",
         "lax", "exoticlinearamortizer","operations",
         "operationalcf","investments","reserves","currentaccount")) {

        ## (1) initialize graphics object
        graph <- initializeBasicCTGraphic(df, start, end, by)
        graph[["title"]] <- paste0("Contract ID: ",contractId)

        ## (2) add layers according to contract type
        graph[["y1.lab"]] <- "Notional/Principal"
        if (contractType == "Investments"){
          graph[["y2.lab"]] <- "Depreciation"
        } else {
          graph[["y2.lab"]] <- "Interest Payments"
        }
        graph <- addNotionalPrincipalPaymentLayer(graph, df, axis = "NULL")
        graph <- addNotionalPrincipalStateLayer(graph, df, axis = "NULL")
        graph <- addPrincipalRedemptionLayer(graph, df, axis = "NULL")
        graph <- addInterestPaymentLayer(graph, df, axis = "NULL")
        graph <- addCapitalisationLayer(graph, df, axis = "NULL")
        graph <- addInterestAccrualsLayer(graph, df, axis = "NULL")
        graph <- addRateResetLayer(graph, df, axis = "NULL")

        ## (3) finally draw graphic
        ## print plot to external file
        ##png(file = file, width = 680, height = 480)
        drawBasicCTGraphic(graph)
        ##dev.off()

    } else if(tolower(gsub(" ", "", contractType)) %in%
              c("stk", "stock")) { ## obviously a Stock

        df$NominalValue <- 0
        ## (1) initialize graphics object
        graph <- initializeBasicCTGraphic(df, start, end, by)
        graph[["title"]] <- paste0("Contract ID: ",contractId)

        ## (2) add layers according to contract type
        graph[["y1.lab"]] <- "Notional/Principal"
        graph[["y2.lab"]] <- "Dividend Payments"
        graph <- addNotionalPrincipalPaymentLayer(graph, df, axis = "NULL")
        #graph <- addNotionalPrincipalStateLayer(graph, df, axis = "NULL")
        graph <- addDividendLayer(graph, df, axis = "NULL")

        ## (3) finally draw graphic
        ## print plot to external file
        ##png(file = file, width = 680, height = 480)
        drawBasicCTGraphic(graph)
        ##dev.off()

    } else { ## combined CT

        ## what is the type of child 1?
        child1Type = optList$childType[1]

        ## (0) preparation: separate child and parent events
        df.parent <- subset(df, subset = Level == "P")
        df.child1 <- subset(df, subset = Level == "C1" | Type == "AD0")
        children <- list(df.child1)
        df.child2 <- subset(df, subset = Level == "C2")
        if(nrow(df.child2)>0) {
            child2Type <- optList$childType[2]
            df.child2 <- subset(df, subset = Level == "C2" | Type == "AD0")
            children[[2]] <- df.child2
        }

        ## (1) initialize graphics object
        graph <- initializeCombinedCTGraphic(df.parent, children, start, end, by)
        graph[["title"]] <- paste0("Contract ID: ",contractId)

        ## (2) add parent layers
        graph <- addNotionalPrincipalPaymentLayer(graph, df.parent, axis = "P")
        graph <- addMarginingLayer(graph, df.parent, axis = "P")

        ## (3) add children layers
        ##     child 1
        childCT <- child1Type
        graph <- addChildLayers(graph, children[[1]], childCT, axis = "C1")
        ##     child 2 (if exists)
        if(length(children)>1){
            childCT <- child2Type
            graph <- addChildLayers(graph, children[[2]], childCT, axis = "C2")
        }

        ## (4) finally draw graphic
        ## print plot to external file
        ##png(file = file, width = 680, height = 480)
        drawCombinedCTGraphic(graph)
        ##dev.off()
    }

}


drawBasicCTGraphic <- function(obj) {

    ## (1) extract graphics parameters
    ## ~~~~~~~~~~~~~~~~~~~~~~~~~~
    plot.title <- obj[["title"]]
    x.lab <- obj[["x.lab"]]
    y1.lab <- obj[["y1.lab"]]
    y2.lab <- obj[["y2.lab"]]
    xaxis <- obj[["xaxis"]]
    x.stretch <- obj[["x.stretch"]]
    x.lim <- obj[["x.lim"]]
    y.lim <- obj[["y.lim"]]
    y.min <- y.lim[1]
    y.max <- y.lim[2]
    xlabels <- obj[["xlabels"]]
    ylabels <- obj[["ylabels"]]
    y2labels <- obj[["y2labels"]]
    events <- unique(as.character(obj[["events"]]))

    ## (2) Draw empty canvas
    ## ~~~~~~~~~~~~~~~~~~~~~~~~~~
    ##dev.new(width = window.size$width, height = window.size$height)
    par(mar = c(8, 4, 4, 4) + 0.1)
    plot(xaxis, rep(y.lim, length.out = length(xaxis)),
         type = "n",
         xlim = x.lim, xaxt = "n", xlab = x.lab,
         ylim = y.lim, yaxt = "n", ylab = "")
    axis(side = 1, at = xlabels$at, labels = xlabels$label, las = 2)
    axis(side = 2, at = ylabels$at, labels = ylabels$label, las = 1)
    ## add 0-base line
    abline(h = 0, lty = 1, lwd = 2.5, col = 1)
    ## add title
    title(main = plot.title)
    ## add axis titles

    ## add secondary y axis
    mtext(side = 2, line = 3, text = y1.lab)
    if(!is.null(y2labels)) {
        axis(side = 4, at = y2labels$at, labels = y2labels$label, las = 1)
        mtext(side = 4, line = 3, text = y2.lab)
    }

    ## add legend
    pars.draw <- getEventParameters()[events, ]
    if(nrow(pars.draw)>0) {
        legend("bottom", inset = c(0, -0.35), horiz = TRUE,
               legend = pars.draw$description,
               col = pars.draw$color,
               lty = pars.draw$linetype,
               lwd = 2, cex = 0.7, xpd = TRUE)
    }

    ## (3) Add different layers
    ## ~~~~~~~~~~~~~~~~~~~~~~~~~~
    ## text
    out <- lapply(obj[["text"]], function(i) {
        text(x = i$x, y = i$y, labels = i$labels, cex = i$cex)
        abline(v = i$x, lty = 2, col = "grey")
    })

    ## lines
    out <- lapply(obj[["lines"]], function(i) {
        apply(i, 1, FUN = function(x){
            lines(as.numeric(x[c("x0", "x1")]), as.numeric(x[c("yStart", "yEnd")]),
                  lty = i$lty, lwd = i$lwd, col = as.character(i$col))
        })
    })

    ## arrows
    out <- lapply(obj[["arrows"]], function(i) {
        arrows(x0 = i$x0, y0 = i$yStart,
               x1 = i$x1, y1 = i$yEnd,
               length = 0.1,
               lty = i$lty, lwd = i$lwd, col = as.character(i$col))
    })

    ## cycles
    out <- lapply(obj[["cycles"]], function(i) {
        lines(i$x, i$y, lty = i$lty, lwd = i$lwd, col = as.character(i$col))
    })

}

drawCombinedCTGraphic <- function(obj) {

    ## (1) extract graphics parameters
    ## ~~~~~~~~~~~~~~~~~~~~~~~~~~
    plot.title <- obj[["title"]]
    ## x axis
    x.lab <- obj[["x.lab"]]
    xaxis <- obj[["xaxis"]]
    x.stretch <- obj[["x.stretch"]]
    x.lim <- obj[["x.lim"]]
    xlabels <- obj[["xlabels"]]
    ## y axis
    y.lim <- obj[["y11.lim"]]
    y.min <- y.lim[1]
    y.max <- y.lim[2]
    y11.lab <- obj[["y11.lab"]]
    y12.lab <- obj[["y12.lab"]]
    y11labels <- obj[["y11labels"]]
    y12labels <- obj[["y12labels"]]
    y21.lab <- obj[["y21.lab"]]
    y22.lab <- obj[["y22.lab"]]
    y21labels <- obj[["y21labels"]]
    y22labels <- obj[["y22labels"]]
    y31.lab <- obj[["y31.lab"]]
    y32.lab <- obj[["y32.lab"]]
    y31labels <- obj[["y31labels"]]
    y32labels <- obj[["y32labels"]]
    events <- unique(as.character(obj[["events"]]))

    ## (2) Draw empty canvas
    ## ~~~~~~~~~~~~~~~~~~~~~~~~~~
    ##dev.new(width = window.size$width, height = window.size$height)
    ##win.graph(width = 20, height = 15)
    mar2 <- mar4 <- 8

    ## if we draw only one primary y axis, adapt margin
    if(is.null(y12labels)) {
        mar2 <- 4
    }
     if(is.null(y22labels)) {
       mar4 <- 4
     }
    par(mar = c(8, mar2, 4, mar4) + 0.1)
    plot(xaxis, rep(y.lim, length.out = length(xaxis)),
         type = "n",
         xlim = x.lim, xaxt = "n", xlab = x.lab,
         ylim = y.lim, yaxt = "n", ylab = "")

    ## (3) x (time) axis
    ## ~~~~~~~~~~~~~~~~~~~~~~~~~~
    axis(side = 1, at = xlabels$at, labels = xlabels$label, las = 2)
    ## no axis title

    ## (4) y axis (primary, secondary and if specified tertiary)
    ## ~~~~~~~~~~~~~~~~~~~~~~~~~~
    ## i. primary y axis
    line = 0
    if(!is.null(y12labels)) {
        ## second primary y axis
        axis(side = 2, at = y12labels$at, labels = y12labels$label, las = 1,
             line = line)
        mtext(side = 2, line = line + 2.5, text = y12.lab)
        line = 3.5
    }
    ## first primary y axis
    axis(side = 2, at = y11labels$at, labels = y11labels$label, las = 1, line = line)
    ## axis title
    mtext(side = 2, line = line + 3, text = y11.lab)

    ## ii. secondary y axis
    ## first secondary y axis
    axis(side = 4, at = y21labels$at, labels = y21labels$label, las = 1, line = 0)
    mtext(side = 4, line = line+2.5, text = y21.lab)


    if(!is.null(y22labels)) {
      axis(side = 4, at = y22labels$at, labels = y22labels$label, las = 1, line=4)
    }

    ## second secondary y axis
    ## iii. tertiary y axis
    if(!is.null(y31labels)) {
        ## first secondary y axis
      axis(side = 4, at = y31labels$at, labels = y31labels$label, las = 1)
      #axis(side = 4, at = y31labels$at, labels = y31labels$label, las = 1, line = 6.0)
        ## second secondary y axis
        axis(side = 4, at = y32labels$at, labels = y32labels$label, las = 1)

        ## axis titles
        y21.lab <- "C1, C2: Notional/Principal"
        y22.lab <- "C1, C2: Cyclical Cashflows"

    ## axis titles
    mtext(side = 4, line = 4.4 + 2.5, text = y21.lab)

    }


    if(!is.null(y22labels)) {
    #mtext(side = 4, line = 2.5, text = y22.lab)
    mtext(side = 4, line = 7, text = y22.lab)
    }

    ## (5) add 0 base line
    ## ~~~~~~~~~~~~~~~~~~~~~~~~~~
    abline(h = 0, lty = 1, lwd = 2.5, col = 1)

    ## (6) add graphic title
    ## ~~~~~~~~~~~~~~~~~~~~~~~~~~
    title(main = plot.title)

    ## (8) add legend
    ## ~~~~~~~~~~~~~~~~~~~~~~~~~~
    pars.draw <- getEventParameters()[events, ]
    if(nrow(pars.draw)>0) {
        legend("bottom", inset = c(0, -0.29), horiz = TRUE,
               legend = pars.draw$description,
               col = pars.draw$color,
               lty = pars.draw$linetype,
               lwd = 2, cex = 0.6, xpd = TRUE)
    }

    ## (9) Add different layers
    ## ~~~~~~~~~~~~~~~~~~~~~~~~~~
    ## text
    out <- lapply(obj[["text"]], function(i) {
        text(x = i$x, y = i$y, labels = i$labels, cex = i$cex)
        abline(v = i$x, lty = 2, col = "grey")
    })

    ## arrows
    out <- lapply(obj[["arrows"]], function(i) {
        arrows(x0 = i$x0, y0 = i$yStart,
               x1 = i$x1, y1 = i$yEnd,
               length = 0.1,
               lty = i$lty, lwd = i$lwd, col = as.character(i$col))
    })

    ## lines
    out <- lapply(obj[["lines"]], function(i) {
        apply(i, 1, FUN = function(x){
            lines(as.numeric(x[c("x0", "x1")]), as.numeric(x[c("yStart", "yEnd")]),
                  lty = i$lty, lwd = i$lwd, col = as.character(i$col))
        })
    })

    ## cycles
    out <- lapply(obj[["cycles"]], function(i) {
        lines(i$x, i$y, lty = i$lty, lwd = i$lwd, col = as.character(i$col))
    })

}

initializeBasicCTGraphic <- function(rawdata, start, end, by) {
  
  ## (1) Define axis
  ## ~~~~~~~~~~~~~~~~~~~~~~~~~~
  
  ## define time axis
  ## (as indicated by method arguments start, end, by)
  timeaxis <- as.character(seq(timeDate(start), as.timeDate(end), by = by))
  ## stretch timeaxis in order to use additional points between
  ## dates as rr-cycle support, of the stretched timeaxis we get
  ## our xaxis
  x.stretch <- 10
  xaxis <- seq(as.numeric(as.timeDate(timeaxis[1])), by = 1,
               length.out = (x.stretch * length(timeaxis)))
  x.range <- c(min(xaxis), max(xaxis))
  
  ## (2) define y-axis range
  ## ~~~~~~~~~~~~~~~~~~~~~~~~~~
  y1toy2 <- 0.5 ## ratio between y1 and y2 scales
  y1Data <- c(as.numeric(subset(rawdata, subset =
                                  Type %in% c("CDD", "IED", "PRD", "TD", "MD","OPS","DPR","RES","ETA","ITF"))[,"Value"]))
  if(!class(rawdata$NominalValue)=="NULL")
  {
    y1Data<-c(y1Data,as.numeric(rawdata[, "NominalValue"]))
  }
  y.max <- max(abs(y1Data), na.rm = TRUE)
  y.max <- 10*ceiling(y.max/10)
  y.min <- -10*ceiling(0.2 * y.max/10)
  y.range <- c(y.min, y.max)
  
  ## (3) define x-/y-axis ticks and labels
  ## ~~~~~~~~~~~~~~~~~~~~~~~~~~
  x.tck <- sort(as.numeric(unique(as.timeDate(rawdata$Date))))
  x.tck <- x.tck[which(x.tck %in% as.numeric(as.timeDate(timeaxis)), arr.ind = TRUE)]
  x.lbl <- timeaxis[which(as.numeric(as.timeDate(timeaxis)) %in% x.tck, arr.ind = TRUE)]
  xlabels <- data.frame(at = xaxis[1] + x.stretch * cumsum(diff(c(xaxis[1], x.tck))),
                        label = x.lbl)
  y.tck <- seq(0, y.max, length.out = 5)
  y.lbl <- y.tck
  ylabels <- data.frame(at = y.tck, label = y.lbl)
  
  ## add secondary y axis (if any data should be drawn on this)
  y2Data <- c(as.numeric(subset(rawdata, subset =
                                  Type %in% c("IP", "IPCI", "PR", "DV", "MR", "STD","DPR"))[, "Value"]))
  if(length(y2Data) > 0) {
    y2.max <- max(abs(y2Data), na.rm = TRUE)
    if(y2.max>0) {
      y2.max <- 10*ceiling(y2.max/10)
      y2.range <- c(y.min, y2.max)
      y2.scale <- y1toy2 * y.max / y2.max
      y2.tck <- seq(0, y2.max, length.out = 5)
      y2.lbl <- y2.tck
      y2labels <- data.frame(at = y2.scale * y2.tck, label = y2.lbl)
    } else {
      y2.range <- y.range
      y2.scale <- y1toy2
      y2labels <- ylabels
    }
  } else {
    y2.range <- NULL
    y2.scale <- NULL
    y2labels <- NULL
  }
  
  ## add scaling y axis (if any data should be drawn on this)
  yscData <- c(as.numeric(subset(rawdata, subset =
                                   Type %in% c("SC"))[, "Value"]))
  if(length(yscData) > 0) {
    ysc.max <- max(abs(yscData), na.rm = TRUE)
    if(ysc.max>0) {
      ysc.max <- ceiling(ysc.max)
      ysc.range <- c(y.min, ysc.max)
      ysc.scale <- y1toy2 * (y.max-y.max*1/3) / ysc.max
      ysc.tck <- seq(0, ysc.max, length.out = 4)
      ysc.lbl <- ysc.tck
      ysclabels <- data.frame(at = (ysc.scale * ysc.tck)+y.max*2/3, label = ysc.lbl)
    } else {
      ysc.range <- y.range
      ysc.scale <- y1toy2
      ysclabels <- ylabels
    }
  } else {
    ysc.range <- NULL
    ysc.scale <- NULL
    ysclabels <- NULL
  }
  
  ## (4) create graphics object/a list of all parameters and data
  ## ~~~~~~~~~~~~~~~~~~~~~~~~~~
  obj <- list(title = "Standardized Contract Type",
              x.lab = "", y1.lab = "Principal/Notional", y2.lab = "Cyclical Cashflows", ysc.lab = "Scaling",
              xaxis = xaxis, x.stretch = x.stretch, x.lim = x.range,
              y.lim = y.range, y2.lim = y2.range, y2.scale = y2.scale,ysc.lim = ysc.range, ysc.scale = ysc.scale,
              xlabels = xlabels, ylabels = ylabels, y2labels = y2labels,ysclabels = ysclabels,
              text = list(),
              lines = list(),
              arrows = list())
  
  ## add ad0 event only in text form
  ad0Data <- subset(rawdata, subset = Type == "AD0")
  if(nrow(ad0Data) > 0) {
    text <- "AD0"
    x.pos <- xaxis[1] + x.stretch *
      cumsum(diff(c(xaxis[1], as.numeric(as.timeDate(ad0Data$Date)))))
    y.pos <- y.min / 1.5
    obj[["text"]][[length(obj[["text"]])+1]] <-
      data.frame(x = x.pos, y = y.pos, labels = text, cex = 0.8)
    obj[["events"]] <- "AD0"
  }
  
  ## return graphics object
  return(obj)
}

initializeCombinedCTGraphic <- function(parent, children, start, end, by) {
  
  ## (1) Define x-axis
  ## ~~~~~~~~~~~~~~~~~~~~~~~~~~
  ## define time axis
  ## (as indicated by method arguments start, end, by)
  timeaxis <- as.character(seq(timeDate(start), as.timeDate(end), by = by))
  ## stretch timeaxis in order to use additional points between
  ## dates as rr-cycle support, of the stretched timeaxis we get
  ## our xaxis
  x.stretch <- 10
  xaxis <- seq(as.numeric(as.timeDate(timeaxis[1])), by = 1,
               length.out = (x.stretch * length(timeaxis)))
  x.range <- c(min(xaxis), max(xaxis))
  rawdata <- rbind(parent, children[[1]])
  x.tck <- sort(as.numeric(unique(as.timeDate(rawdata$Date))))
  x.tck <- x.tck[which(x.tck %in% as.numeric(as.timeDate(timeaxis)), arr.ind = TRUE)]
  x.lbl <- timeaxis[which(as.numeric(as.timeDate(timeaxis)) %in% x.tck, arr.ind = TRUE)]
  xlabels <- data.frame(at = xaxis[1] + x.stretch * cumsum(diff(c(xaxis[1], x.tck))),
                        label = x.lbl)
  
  ## (2) define y-axis range
  ## ~~~~~~~~~~~~~~~~~~~~~~~~~~
  ##     i) primary y axis (left hand side in the graphic) is parent
  y11toy12 <- 0.5 ## ratio between y1.1 and y1.2 scales (of secondary y-axis)
  rawdata <- parent
  y11Data <- abs(c(as.numeric(subset(rawdata, subset =
                                       Type %in% c("CDD", "IED", "PRD", "TD", "MD",
                                                   "STD", "OPPD", "OPXED"))[,"Value"])))
  if(!class(rawdata$NominalValue)=="NULL")
  {
    y11Data<-abs(c(y11Data,as.numeric(rawdata[, "NominalValue"])))
  } 
  if(max(y11Data)==0) {
    y11Data <- unlist(lapply(children, FUN = function(x) {max(abs(x[,c("Value", "NominalValue")]))}))
  }
  y12Data <- abs(c(as.numeric(subset(rawdata, subset =
                                       Type %in% c("MR"))[, "Value"])))
  if(length(y12Data)==0) {
    y12Data <- 0
  }
  y11.max <- max(y11Data, na.rm = TRUE)
  y12.max <- max(y12Data, na.rm = TRUE)
  y11.max <- 10*ceiling(y11.max/10)
  y12.max <- 10*ceiling(y12.max/10)
  ##
  ##       decide whether parent events are spread over two separate
  ##       scales or not -> if yes, create a second primary y axis!
  if(y12.max == 0 || abs(y11.max - y12.max) <= 0.5 * y12.max) {
    y12.tck <- NULL
    y12.lbl <- NULL
    y12labels <- NULL
    y11.lab <- "Parent Cashflows"
    y12.lab <- NULL
    y12.scale <- 1
    y11.max <- max(y11.max, y12.max)
  } else {
    y12.scale <- y11toy12 * y11.max / y12.max
    y12.tck <- seq(0, y12.max, length.out = 5)
    y12.lbl <- y12.tck
    y12labels <- data.frame(at = y12.scale * y12.tck, label = y12.lbl)
    y11.lab <- "P: Notional/Principal"
    y12.lab <- "P: Margining"
  }
  ##       axis 1 of primary y axis (notional values)
  if(length(children) == 1) {
    y.min <- -10*ceiling(0.2 * y11.max/10)
  } else {
    y.min <- -y11.max
  }
  y11.range <- c(y.min, y11.max)
  y11.tck <- seq(0, y11.max, length.out = 5)
  y11.lbl <- y11.tck
  y11labels <- data.frame(at = y11.tck, label = y11.lbl)
  y12.range <- c(y.min, y12.max)
  
  ##     ii) secondary 1-y axis (upper right hand side in the graphic) is child
  ##         -secondary 2.1 is notional of child 1
  ##         -secondary 2.2 is cyclical cash flows of child 1
  y1toy2 <- 0.6
  y21toy22 <- 0.5 ## ratio between y1.1 and y1.2 scales (of secondary y-axis)
  rawdata <- children[[1]]
  y21Data <- c(as.numeric(subset(rawdata, subset =
                                   Type %in% c("CDD", "IED", "PRD", "TD", "MD"))[,"Value"]))
  if(length(y21Data)==0) {
    y21Data <- 0
  }
  if(!class(rawdata$NominalValue)=="NULL")
  {
    y21Data<-c(y21Data,as.numeric(rawdata[,"NominalValue"]))
  }
  
  y21.max <- max(abs(y21Data), na.rm = TRUE)
  y21.max <- 10*ceiling(y21.max/10)
  y21.range <- c(y.min, y21.max)
  if(!y21.max==0)
  {
    y21.scale <- y1toy2 * y11.max / y21.max
  }else
  {
    y21.scale<-0
  }
  y21.tck <- seq(0, y21.max, length.out = 5)
  y21.lbl <- y21.tck
  y21labels <- data.frame(at = y21.scale * y21.tck, label = y21.lbl)
  
  y22Data <- c(as.numeric(subset(rawdata, subset =
                                   Type %in% c("IP", "PR", "IPCI", "DV"))[, "Value"]))
  
  ##         in case of a Stock underlying, we don't want to consider the notional
  ##         for definition of axis
  #   if(tolower(gsub(" ", "", child2Type)) %in%
  #        c("stk", "stock")) {
  #     y22Data <- as.numeric(subset(rawdata, subset =
  #                                    Type %in% c("CDD", "IED", "PRD", "TD", "MD"))[,"Value"])
  #   }
  
  if(length(y22Data) > 0) {
    y22.max <- max(abs(y22Data), na.rm = TRUE)
    y22.max <- 10*ceiling(y22.max/10)
    y22.range <- c(y.min, y22.max)
    if(!y22.max==0)
    {
      y22.scale <- y1toy2 * y21toy22 * y11.max / y22.max
    }else
    {
      y22.scale<-0
    }
    
    y22.tck <- seq(0, y22.max, length.out = 5)
    y22.lbl <- y22.tck
    y22labels <- data.frame(at = y22.scale * y22.tck, label = y22.lbl)
  } else {
    y22.range <- NULL
    y22.scale <- NULL
    y22labels <- NULL
  }
  
  
  
  
  ## (3) create graphics object/a list of all parameters and data
  ## ~~~~~~~~~~~~~~~~~~~~~~~~~~
  obj <- list(title = "Standardized Contract Type",
              x.lab = "",
              y11.lab = y11.lab, y12.lab = y12.lab,
              y21.lab = "C1: Notional/Principal", y22.lab = "C1: Cyclical Cashflows",
              y31.lab = NULL, y32.lab = NULL,
              xaxis = xaxis, x.stretch = x.stretch, x.lim = x.range,
              y11.lim = y11.range, y12.lim = y12.range,
              y21.lim = y21.range, y22.lim = y22.range,
              y31.lim = NULL, y32.lim = NULL,
              y12.scale = y12.scale,
              y21.scale = y21.scale, y22.scale = y22.scale,
              y31.scale = NULL, y32.scale = NULL,
              xlabels = xlabels, y11labels = y11labels, y12labels = y12labels,
              y21labels = y21labels, y22labels = y22labels,
              y31labels = NULL, y32labels = NULL,
              events = character(),
              text = list(),
              lines = list(),
              arrows = list())
  
  ## (2) define y-axis of second child
  ## ~~~~~~~~~~~~~~~~~~~~~~~~~~
  ##     secondary 2-y axis (lower right hand side in the graphic) is child 2
  ##     -secondary 3.1 is notional of child 2
  ##     -secondary 3.2 is cyclical cash flows of child 2
  if(length(children)>1) {
    y1toy3 <- (-1) * y1toy2 ## -1 term forces the lines/arrows on the lower half graph
    y31toy32 <- y21toy22 ## ratio between y3.1 and y3.2 scales (of secondary y-axis)
    rawdata <- children[[2]]
    y31Data <- c(as.numeric(subset(rawdata, subset =
                                     Type %in% c("CDD", "IED", "PRD", "TD", "MD"))[,"Value"]))
    if(!class(rawdata$NominalValue)=="NULL")
    {
      y31Data<-c(y31Data,as.numeric(rawdata[,"NominalValue"]))
    }
    
    y32Data <- c(as.numeric(subset(rawdata, subset =
                                     Type %in% c("IP", "PR", "IPCI", "DV"))[, "Value"]))
    
    if(length(y32Data) > 0) {
      y32.max <- max(abs(y32Data), na.rm = TRUE)
      y32.max <- 10*ceiling(y32.max/10)
      y32.range <- c(y.min, y32.max)
      if(!y32.max==0)
      {
        y32.scale <- y1toy3 * y31toy32 * y11.max / y32.max
      }else
      {
        y32.scale<-0
      }
      
      y32.tck <- seq(0, y32.max, length.out = 5)
      y32.lbl <- y32.tck
      y32labels <- data.frame(at = y32.scale * y32.tck, label = y32.lbl)
    } else {
      y32.range <- NULL
      y32.scale <- NULL
      y32labels <- NULL
    }
    
    y31.max <- max(abs(y31Data), na.rm = TRUE)
    y31.max <- 10*ceiling(y31.max/10)
    y31.range <- c(y.min, y31.max)
    if(!y31.max==0)
    {
      y31.scale <- y1toy3 * y11.max / y31.max
    }else
    {
      y31.scale<-0
    }
    y31.tck <- seq(0, y31.max, length.out = 5)
    y31.lbl <- y31.tck
    y31labels <- data.frame(at = y31.scale * y31.tck, label = y31.lbl)
    
    ## add y-axis of the second child to the graph object
    obj[["y31.lab"]] <- "C2: Notional/Principal"
    obj[["y32.lab"]] <- "C2: Cyclical Cashflows"
    obj[["y31.lim"]] <- y31.range
    obj[["y32.lim"]] <- y32.range
    obj[["y31.scale"]] <- y31.scale
    obj[["y32.scale"]] <- y32.scale
    obj[["y31labels"]] <- y31labels
    obj[["y32labels"]] <- y32labels
  }
  
  ## add ad0 event only in text form
  ad0Data <- subset(parent, subset = Type == "AD0")
  if(nrow(ad0Data) > 0) {
    text <- "AD0"
    x.pos <- xaxis[1] + x.stretch *
      cumsum(diff(c(xaxis[1], as.numeric(as.timeDate(ad0Data$Date)))))
    y.pos <- y.min / 2
    obj[["text"]][[length(obj[["text"]])+1]] <-
      data.frame(x = x.pos, y = y.pos, labels = text, cex = 0.8)
    obj[["events"]] <- unique("AD0")
  }
  
  ## return graphics object
  return(obj)
}

# initializeBasicCTGraphic <- function(rawdata, start, end, by) {
# 
#     ## (1) Define axis
#     ## ~~~~~~~~~~~~~~~~~~~~~~~~~~
# 
#     ## define time axis
#     ## (as indicated by method arguments start, end, by)
#     timeaxis <- as.character(seq(timeDate(start), as.timeDate(end), by = by))
#     ## stretch timeaxis in order to use additional points between
#     ## dates as rr-cycle support, of the stretched timeaxis we get
#     ## our xaxis
#     x.stretch <- 10
#     xaxis <- seq(as.numeric(as.timeDate(timeaxis[1])), by = 1,
#                  length.out = (x.stretch * length(timeaxis)))
#     x.range <- c(min(xaxis), max(xaxis))
# 
#     ## (2) define y-axis range
#     ## ~~~~~~~~~~~~~~~~~~~~~~~~~~
#     y1toy2 <- 0.5 ## ratio between y1 and y2 scales
#     y1Data <- c(as.numeric(subset(rawdata, subset =
#                                  Type %in% c("CDD", "IED", "PRD", "TD", "MD"))[,"Value"]),
#                as.numeric(rawdata[, "NominalValue"]))
#     y.max <- max(abs(y1Data), na.rm = TRUE)
#     y.max <- 10*ceiling(y.max/10)
#     y.min <- -10*ceiling(0.2 * y.max/10)
#     y.range <- c(y.min, y.max)
# 
#     ## (3) define x-/y-axis ticks and labels
#     ## ~~~~~~~~~~~~~~~~~~~~~~~~~~
#     x.tck <- sort(as.numeric(unique(as.timeDate(rawdata$Date))))
#     x.tck <- x.tck[which(x.tck %in% as.numeric(as.timeDate(timeaxis)), arr.ind = TRUE)]
#     x.lbl <- timeaxis[which(as.numeric(as.timeDate(timeaxis)) %in% x.tck, arr.ind = TRUE)]
#     xlabels <- data.frame(at = xaxis[1] + x.stretch * cumsum(diff(c(xaxis[1], x.tck))),
#                           label = x.lbl)
#     y.tck <- seq(0, y.max, length.out = 5)
#     y.lbl <- y.tck
#     ylabels <- data.frame(at = y.tck, label = y.lbl)
# 
#     ## add secondary y axis (if any data should be drawn on this)
#     y2Data <- c(as.numeric(subset(rawdata, subset =
#                                   Type %in% c("IP", "IPCI", "PR", "DV", "MR", "STD"))[, "Value"]))
#     if(length(y2Data) > 0) {
#         y2.max <- max(abs(y2Data), na.rm = TRUE)
#         if(y2.max>0) {
#             y2.max <- 10*ceiling(y2.max/10)
#             y2.range <- c(y.min, y2.max)
#             y2.scale <- y1toy2 * y.max / y2.max
#             y2.tck <- seq(0, y2.max, length.out = 5)
#             y2.lbl <- y2.tck
#             y2labels <- data.frame(at = y2.scale * y2.tck, label = y2.lbl)
#         } else {
#             y2.range <- y.range
#             y2.scale <- y1toy2
#             y2labels <- ylabels
#         }
#     } else {
#         y2.range <- NULL
#         y2.scale <- NULL
#         y2labels <- NULL
#     }
# 
#     ## (4) create graphics object/a list of all parameters and data
#     ## ~~~~~~~~~~~~~~~~~~~~~~~~~~
#     obj <- list(title = "Standardized Contract Type",
#                 x.lab = "", y1.lab = "Principal/Notional", y2.lab = "Cyclical Cashflows",
#                 xaxis = xaxis, x.stretch = x.stretch, x.lim = x.range,
#                 y.lim = y.range, y2.lim = y2.range, y2.scale = y2.scale,
#                 xlabels = xlabels, ylabels = ylabels, y2labels = y2labels,
#                 events = character(),
#                 text = list(),
#                 lines = list(),
#                 arrows = list())
# 
#     ## add ad0 event only in text form
#     ad0Data <- subset(rawdata, subset = Type == "AD0")
#     if(nrow(ad0Data) > 0) {
#         text <- "AD0"
#         x.pos <- xaxis[1] + x.stretch *
#             cumsum(diff(c(xaxis[1], as.numeric(as.timeDate(ad0Data$Date)))))
#         y.pos <- y.min / 1.5
#         obj[["text"]][[length(obj[["text"]])+1]] <-
#             data.frame(x = x.pos, y = y.pos, labels = text, cex = 0.8)
#         obj[["events"]] <- unique(c(obj[["events"]], "AD0"))
#     }
# 
#     ## return graphics object
#     return(obj)
# }
# 
# initializeCombinedCTGraphic <- function(parent, children, start, end, by) {
# 
#     ## (1) Define x-axis
#     ## ~~~~~~~~~~~~~~~~~~~~~~~~~~
#     ## define time axis
#     ## (as indicated by method arguments start, end, by)
#     timeaxis <- as.character(seq(timeDate(start), as.timeDate(end), by = by))
#     ## stretch timeaxis in order to use additional points between
#     ## dates as rr-cycle support, of the stretched timeaxis we get
#     ## our xaxis
#     x.stretch <- 10
#     xaxis <- seq(as.numeric(as.timeDate(timeaxis[1])), by = 1,
#                  length.out = (x.stretch * length(timeaxis)))
#     x.range <- c(min(xaxis), max(xaxis))
#     rawdata <- rbind(parent, children[[1]])
#     x.tck <- sort(as.numeric(unique(as.timeDate(rawdata$Date))))
#     x.tck <- x.tck[which(x.tck %in% as.numeric(as.timeDate(timeaxis)), arr.ind = TRUE)]
#     x.lbl <- timeaxis[which(as.numeric(as.timeDate(timeaxis)) %in% x.tck, arr.ind = TRUE)]
#     xlabels <- data.frame(at = xaxis[1] + x.stretch * cumsum(diff(c(xaxis[1], x.tck))),
#                           label = x.lbl)
# 
#     ## (2) define y-axis range
#     ## ~~~~~~~~~~~~~~~~~~~~~~~~~~
#     ##     i) primary y axis (left hand side in the graphic) is parent
#     y11toy12 <- 0.5 ## ratio between y1.1 and y1.2 scales (of secondary y-axis)
#     rawdata <- parent
#     y11Data <- abs(c(as.numeric(subset(rawdata, subset =
#                  Type %in% c("CDD", "IED", "PRD", "TD", "MD",
#                              "STD", "OPPD", "OPXED"))[,"Value"]),
#                  as.numeric(rawdata[, "NominalValue"])))
#     if(max(y11Data)==0) {
#         y11Data <- unlist(lapply(children, FUN = function(x) {max(x[,c("Value", "NominalValue")])}))
#     }
#     y12Data <- abs(c(as.numeric(subset(rawdata, subset =
#                  Type %in% c("MR"))[, "Value"])))
#     if(length(y12Data)==0) {
#         y12Data <- 0
#     }
#     y11.max <- max(y11Data, na.rm = TRUE)
#     y12.max <- max(y12Data, na.rm = TRUE)
#     y11.max <- 10*ceiling(y11.max/10)
#     y12.max <- 10*ceiling(y12.max/10)
#     ##
#     ##       decide whether parent events are spread over two separate
#     ##       scales or not -> if yes, create a second primary y axis!
#     if(y12.max == 0 || y11.max - y12.max <= 0.5 * y12.max) {
#         y12.tck <- NULL
#         y12.lbl <- NULL
#         y12labels <- NULL
#         y11.lab <- "Parent Cashflows"
#         y12.lab <- NULL
#         y12.scale <- 1
#     } else {
#         y12.scale <- y11toy12 * y11.max / y12.max
#         y12.tck <- seq(0, y12.max, length.out = 5)
#         y12.lbl <- y12.tck
#         y12labels <- data.frame(at = y12.scale * y12.tck, label = y12.lbl)
#         y11.lab <- "P: Notional/Principal"
#         y12.lab <- "P: Margining"
#     }
#     ##       axis 1 of primary y axis (notional values)
#     if(length(children) == 1) {
#         y.min <- -10*ceiling(0.2 * y11.max/10)
#     } else {
#         y.min <- -y11.max
#     }
#     y11.range <- c(y.min, y11.max)
#     y11.tck <- seq(0, y11.max, length.out = 5)
#     y11.lbl <- y11.tck
#     y11labels <- data.frame(at = y11.tck, label = y11.lbl)
#     y12.range <- c(y.min, y12.max)
# 
#     ##     ii) secondary 1-y axis (upper right hand side in the graphic) is child
#     ##         -secondary 2.1 is notional of child 1
#     ##         -secondary 2.2 is cyclical cash flows of child 1
#     y1toy2 <- 0.6
#     y21toy22 <- 0.5 ## ratio between y1.1 and y1.2 scales (of secondary y-axis)
# #     rawdata <- children[[1]]
# #     y21Data <- c(as.numeric(subset(rawdata, subset =
# #                  Type %in% c("CDD", "IED", "PRD", "TD", "MD"))[,"Value"]),
# #                  as.numeric(rawdata[, "NominalValue"]))
# #     y21.max <- max(abs(y21Data), na.rm = TRUE)
# #     y21.max <- 10*ceiling(y21.max/10)
# #     y21.range <- c(y.min, y21.max)
# #     y21.scale <- y1toy2 * y11.max / y21.max
# #     y21.tck <- seq(0, y21.max, length.out = 5)
# #     y21.lbl <- y21.tck
# #     y21labels <- data.frame(at = y21.scale * y21.tck, label = y21.lbl)
# # 
# #     y22Data <- c(as.numeric(subset(rawdata, subset =
# #                  Type %in% c("IP", "PR", "IPCI", "DV"))[, "Value"]))
# # 
# #     if(length(y22Data) > 0) {
# #       y22.max <- max(abs(y22Data), na.rm = TRUE)
# #       y22.max <- 10*ceiling(y22.max/10)
# #       y22.range <- c(y.min, y22.max)
# #       y22.scale <- y1toy2 * y21toy22 * y11.max / y22.max
# #       y22.tck <- seq(0, y22.max, length.out = 5)
# #       y22.lbl <- y22.tck
# #       y22labels <- data.frame(at = y22.scale * y22.tck, label = y22.lbl)
# #     } else {
# #       y22.range <- NULL
# #       y22.scale <- NULL
# #       y22labels <- NULL
# #     }
# 
#     rawdata <- children[[1]]
#     y21Data <- c(as.numeric(subset(rawdata, subset =
#                                      Type %in% c("CDD", "IED", "PRD", "TD", "MD"))[,"Value"]))
#     if(length(y21Data)==0) {
#       y21Data <- 0
#     }
#     if(!class(rawdata$NominalValue)=="NULL")
#     {
#       y21Data<-c(y21Data,as.numeric(rawdata[,"SV.NT"]))
#     }
#     
#     y21.max <- max(abs(y21Data), na.rm = TRUE)
#     y21.max <- 10*ceiling(y21.max/10)
#     y21.range <- c(y.min, y21.max)
#     if(!y21.max==0)
#     {
#       y21.scale <- y1toy2 * y11.max / y21.max
#     }else
#     {
#       y21.scale<-0
#     }
#     y21.tck <- seq(0, y21.max, length.out = 5)
#     y21.lbl <- y21.tck
#     y21labels <- data.frame(at = y21.scale * y21.tck, label = y21.lbl)
#     
#     y22Data <- c(as.numeric(subset(rawdata, subset =
#                                      Type %in% c("IP", "PR", "IPCI", "DV"))[, "Value"]))
#     if(length(y22Data) > 0) {
#       y22.max <- max(abs(y22Data), na.rm = TRUE)
#       y22.max <- 10*ceiling(y22.max/10)
#       y22.range <- c(y.min, y22.max)
#       if(!y22.max==0)
#       {
#         y22.scale <- y1toy2 * y21toy22 * y11.max / y22.max
#       }else
#       {
#         y22.scale<-0
#       }
#       
#       y22.tck <- seq(0, y22.max, length.out = 5)
#       y22.lbl <- y22.tck
#       y22labels <- data.frame(at = y22.scale * y22.tck, label = y22.lbl)
#     } else {
#       y22.range <- NULL
#       y22.scale <- NULL
#       y22labels <- NULL
#     }
#     
#     
# 
# 
#     ## (3) create graphics object/a list of all parameters and data
#     ## ~~~~~~~~~~~~~~~~~~~~~~~~~~
#     obj <- list(title = "Standardized Contract Type",
#                 x.lab = "",
#                 y11.lab = y11.lab, y12.lab = y12.lab,
#                 y21.lab = "C1: Notional/Principal", y22.lab = "C1: Cyclical Cashflows",
#                 y31.lab = NULL, y32.lab = NULL,
#                 xaxis = xaxis, x.stretch = x.stretch, x.lim = x.range,
#                 y11.lim = y11.range, y12.lim = y12.range,
#                 y21.lim = y21.range, y22.lim = y22.range,
#                 y31.lim = NULL, y32.lim = NULL,
#                 y12.scale = y12.scale,
#                 y21.scale = y21.scale, y22.scale = y22.scale,
#                 y31.scale = NULL, y32.scale = NULL,
#                 xlabels = xlabels, y11labels = y11labels, y12labels = y12labels,
#                 y21labels = y21labels, y22labels = y22labels,
#                 y31labels = NULL, y32labels = NULL,
#                 events = character(),
#                 text = list(),
#                 lines = list(),
#                 arrows = list())
# 
#     ## (2) define y-axis of second child
#     ## ~~~~~~~~~~~~~~~~~~~~~~~~~~
#     ##     secondary 2-y axis (lower right hand side in the graphic) is child 2
#     ##     -secondary 3.1 is notional of child 2
#     ##     -secondary 3.2 is cyclical cash flows of child 2
#     if(length(children)>1) {
#         y1toy3 <- (-1) * y1toy2 ## -1 term forces the lines/arrows on the lower half graph
#         y31toy32 <- y21toy22 ## ratio between y3.1 and y3.2 scales (of secondary y-axis)
#         rawdata <- children[[2]]
#         y31Data <- c(as.numeric(subset(rawdata, subset =
#                                        Type %in% c("CDD", "IED", "PRD", "TD", "MD"))[,"Value"]),
#                      as.numeric(rawdata[, "NominalValue"]))
#         y32Data <- c(as.numeric(subset(rawdata, subset =
#                                        Type %in% c("IP", "PR", "IPCI", "DV"))[, "Value"]))
#         y31.max <- max(abs(y31Data), na.rm = TRUE)
#         y32.max <- max(abs(y32Data), na.rm = TRUE)
#         y31.max <- 10*ceiling(y31.max/10)
#         y32.max <- 10*ceiling(y32.max/10)
#         y31.range <- c(y.min, y31.max)
#         y32.range <- c(y.min, y32.max)
#         y31.scale <- y1toy3 * y11.max / y31.max
#         y32.scale <- y1toy3 * y31toy32 * y11.max / y32.max
#         y31.tck <- seq(0, y31.max, length.out = 5)
#         y31.lbl <- y31.tck
#         y31labels <- data.frame(at = y31.scale * y31.tck, label = y31.lbl)
#         y32.tck <- seq(0, y32.max, length.out = 5)
#         y32.lbl <- y32.tck
#         y32labels <- data.frame(at = y32.scale * y32.tck, label = y32.lbl)
# 
#         ## add y-axis of the second child to the graph object
#         obj[["y31.lab"]] <- "C2: Notional/Principal"
#         obj[["y32.lab"]] <- "C2: Cyclical Cashflows"
#         obj[["y31.lim"]] <- y31.range
#         obj[["y32.lim"]] <- y32.range
#         obj[["y31.scale"]] <- y31.scale
#         obj[["y32.scale"]] <- y32.scale
#         obj[["y31labels"]] <- y31labels
#         obj[["y32labels"]] <- y32labels
#     }
# 
#     ## add ad0 event only in text form
#     ad0Data <- subset(parent, subset = Type == "AD0")
#     if(nrow(ad0Data) > 0) {
#         text <- "AD0"
#         x.pos <- xaxis[1] + x.stretch *
#             cumsum(diff(c(xaxis[1], as.numeric(as.timeDate(ad0Data$Date)))))
#         y.pos <- y.min / 2
#         obj[["text"]][[length(obj[["text"]])+1]] <-
#             data.frame(x = x.pos, y = y.pos, labels = text, cex = 0.8)
#         obj[["events"]] <- unique(c(obj[["events"]], "AD0"))
#     }
# 
#     ## return graphics object
#     return(obj)
# }


addNotionalPrincipalStateLayer <- function(obj, rawdata, axis) {
    ## what is the axis to draw on?
    if(axis == "NULL") {
        y1.lim <- obj[["y.lim"]]
        y1.scale <- 1
    } else if(axis == "P") {
        y1.lim <- obj[["y11.lim"]]
        y1.scale <- obj[["y11.scale"]]
    } else if(axis == "C1") {
        y1.lim <- obj[["y21.lim"]]
        y1.scale <- obj[["y21.scale"]]
    } else if(axis == "C2") {
        y1.lim <- obj[["y31.lim"]]
        y1.scale <- obj[["y31.scale"]]
    } else {
        stop("Please give a valid level: {NULL, P, C1, C2}!")
    }

    ## extract graphics-parameters
    xaxis <- obj[["xaxis"]]
    x.stretch <- obj[["x.stretch"]]
    y.min <- y1.lim[1]
    y.max <- y1.lim[2]
    y.scale <- y1.scale

    ## transform to data frame
    df <- as.data.frame(rawdata)

    ## get graphical parameters
    pars <- getEventParameters()["NominalValue", ]

    ## extract layer relevant data and bring in graphics form
    ## notice that we only need AD0 on Parent level (in a combined contract)
    subs <- c("IED", "PRD", "IPCI", "PR", "MD", "TD","DPR","ETA","ITF")
    if(!(axis %in% c("C1", "C2"))) {
        subs <- c("AD0", subs)
    }
    data <- subset(x = rawdata, subset = Type %in% subs)[,c("Date", "Type", "Value", "NominalValue")]
    ## if corresponding events (at least 2 for states) exist, add to the graphic
    if(nrow(data) > 1) {
        xStart <- as.numeric(as.timeDate(matrix(rbind(data$Date[-nrow(data)],
                          data$Date[-1]), ncol = 1, byrow = FALSE)))
        xEnd <- as.numeric(as.timeDate(matrix(rbind(data$Date[-1],
                          data$Date[-1]), ncol = 1, byrow = FALSE)))
        x0 <- xaxis[1] + x.stretch * cumsum(diff(c(xaxis[1], xStart)))
        x1 <- xaxis[1] + x.stretch * cumsum(diff(c(xaxis[1], xEnd)))
        yStart <- y.scale * abs(matrix(rbind(data$NominalValue[-nrow(data)],
                          data$NominalValue[-nrow(data)]), ncol = 1, byrow = FALSE))
        yEnd <- y.scale * abs(matrix(rbind(data$NominalValue[-nrow(data)],
                          data$NominalValue[-1]), ncol = 1, byrow = FALSE))
        type <- matrix(rbind(as.character(data$Type[-nrow(data)]),
                          as.character(data$Type[-1])), ncol = 1, byrow = FALSE)
        ntData <- data.frame(x0 = x0, x1 = x1,
                             yStart = yStart, yEnd = yEnd,
                             Type = type,
                             lty = pars$linetype,
                             lwd = pars$linewidth,
                             col = pars$color                             )
        ntData$Type <- as.character(ntData$Type)

        ## add graphical parameters
        obj[["lines"]][[length(obj[["lines"]])+1]] <- ntData
    }

    ## return the updated object
    return(obj)
}


addNotionalPrincipalPaymentLayer <- function(obj, rawdata, axis) {
    ## what is the axis to draw on?
    if(axis == "NULL") {
        y1.lim <- obj[["y.lim"]]
        y1.scale <- 1
    } else if(axis == "P") {
        y1.lim <- obj[["y11.lim"]]
        y1.scale <- 1
    } else if(axis == "C1") {
        y1.lim <- obj[["y21.lim"]]
        y1.scale <- obj[["y21.scale"]]
    } else if(axis == "C2") {
        y1.lim <- obj[["y31.lim"]]
        y1.scale <- obj[["y31.scale"]]
    } else {
        stop("Please give a valid level: {NULL, P, C11, C21}!")
    }

    ## extract graphics-parameters
    xaxis <- obj[["xaxis"]]
    x.stretch <- obj[["x.stretch"]]
    y.min <- y1.lim[1]
    y.max <- y1.lim[2]
    y.scale <- y1.scale

    ## transform to data frame
    df <- as.data.frame(rawdata)

    ## get graphical parameters
    if ("OPS" %in% df$Type) {
      pars <- getEventParameters()["OPS", ]
    }else {
      pars <- getEventParameters()["IED", ]
    }
    

    ## extract layer relevant data and bring in graphics form
    data <- subset(x = df, subset = Type %in% c("IED", "MD", "PRD", "TD",
                           "STD", "OPPD", "OPXED","OPS","RES","ETA"))

    if(nrow(data) > 0) {
        ## prepare x and y positions of cashflows
        yStart <- y.scale * abs(data$Value)
        yStart[which(data$Value<0)] <- 0
        yEnd <- y.scale * abs(data$Value)
        yEnd[which(data$Value>0)] <- 0
        xStart <- as.numeric(as.timeDate(data$Date))
        xEnd <- as.numeric(as.timeDate(data$Date))
        ntData <- data.frame(x0 = xaxis[1] + x.stretch * cumsum(diff(c(xaxis[1], xStart))),
                             x1 = xaxis[1] + x.stretch * cumsum(diff(c(xaxis[1], xEnd))),
                             yStart = yStart, yEnd = yEnd, Type = data$Type,
                             lty = pars$linetype,
                             lwd = pars$linewidth,
                             col = pars$color)
        ## prepare x and y positions of event text
        text <- as.character(ntData$Type)
        x.pos <- ntData$x0
        y.pos <- y.min / 2
        ## do only draw arrows for events with values > 0
        ntData <- subset(x = ntData, subset = yStart != yEnd)
        ## add event text and cashflows (arrows) to the graphic object
        obj[["text"]][[length(obj[["text"]])+1]] <-
            data.frame(x = x.pos, y = y.pos, labels = text, cex = 0.8)
        obj[["arrows"]][[length(obj[["arrows"]])+1]] <- ntData
        obj[["events"]] <- unique(c(obj[["events"]], as.character(data$Type)))
    }

    ## add cdd event only in text form
    cddData <- subset(df, subset = Type == "CDD")
    if(nrow(cddData) > 0) {
        text <- "CDD"
        x.pos <- xaxis[1] + x.stretch *
            cumsum(diff(c(xaxis[1], as.numeric(as.timeDate(cddData$Date)))))
        y.pos <- y.min / 1.5
        obj[["text"]][[length(obj[["text"]])+1]] <-
            data.frame(x = x.pos, y = y.pos, labels = text, cex = 0.8)
        obj[["events"]] <- unique(c(obj[["events"]], "CDD"))
    }


    ## return the updated object
    return(obj)
}


addInterestPaymentLayer <- function(obj, rawdata, axis) {

    ## what is the axis to draw on?
    if(axis == "NULL") {
        y2.lim <- obj[["y2.lim"]]
        y2.scale <- obj[["y2.scale"]]
    } else if(axis == "P") {
        y2.lim <- obj[["y12.lim"]]
        y2.scale <- obj[["y12.scale"]]
    } else if(axis == "C1") {
        y2.lim <- obj[["y22.lim"]]
        y2.scale <- obj[["y22.scale"]]
    } else if(axis == "C2") {
        y2.lim <- obj[["y32.lim"]]
        y2.scale <- obj[["y32.scale"]]
    } else {
        stop("Please give a valid level: {NULL, P, C11, C21}!")
    }

    ## extract graphics-parameters
    if(!is.null(y2.lim)) {
        xaxis <- obj[["xaxis"]]
        x.stretch <- obj[["x.stretch"]]
        y.max <- y2.lim[2]
        y.scale <- y2.scale
    }

    ## transform to data frame
    df <- as.data.frame(rawdata)

    ## get graphical parameters
    if ("DPR" %in% df$Type) {
      pars <- getEventParameters()["DPR", ]
    } else {
      pars <- getEventParameters()["IP", ]
    }

    ## extract layer relevant data and bring in graphics form
    data <- subset(x = df, subset = Type %in% c("IP","ITF","DPR"))
    ## aggregate raw data to timeaxis dates
    ## ytd ...
    if(nrow(data)>0) {
        ## prepare x and y positions of cashflows
        yStart <- y.scale * abs(data$Value)
        yStart[which(data$Value<0)] <- 0
        yEnd <- y.scale * abs(data$Value)
        yEnd[which(data$Value>0)] <- 0
        xStart <- as.numeric(as.timeDate(data$Date))
        xEnd <- as.numeric(as.timeDate(data$Date))
        ipData <- data.frame(x0 = xaxis[1] + x.stretch * cumsum(diff(c(xaxis[1], xStart))),
                             x1 = xaxis[1] + x.stretch * cumsum(diff(c(xaxis[1], xEnd))),
                             yStart = yStart, yEnd = yEnd, Type = data$Type,
                             lty = pars$linetype,
                             lwd = pars$linewidth,
                             col = pars$color)
        ## prepare x and y positions of event text
        ## we always want to have the event name written above the arrow,
        ## no matter what direction it points to (in/outflow). Since, either
        ## yStart or yEnd of an arrow must be 0 by definition, we use their sum
        text <- as.character(ipData$Type)
        x.pos <- ipData$x0
        y.pos <- yStart + yEnd + y.scale*y.max/15
        ## do only draw arrows for events with values > 0
        ipData <- subset(x = ipData, subset = yStart != yEnd)
        ## add event text and cashflows (arrows) to the graphic object
        obj[["text"]][[length(obj[["text"]])+1]] <-
            data.frame(x = x.pos, y = y.pos, labels = text, cex = 0.8)
        obj[["arrows"]][[length(obj[["arrows"]])+1]] <- ipData
        obj[["events"]] <- c(obj[["events"]], "IP")
    }

    ## return the updated object
    return(obj)

}

addPrincipalRedemptionLayer <- function(obj, rawdata, axis) {
    ## what is the axis to draw on?
    if(axis == "NULL") {
        y2.lim <- obj[["y2.lim"]]
        y2.scale <- obj[["y2.scale"]]
    } else if(axis == "P") {
        y2.lim <- obj[["y12.lim"]]
        y2.scale <- obj[["y12.scale"]]
    } else if(axis == "C1") {
        y2.lim <- obj[["y22.lim"]]
        y2.scale <- obj[["y22.scale"]]
    } else if(axis == "C2") {
        y2.lim <- obj[["y32.lim"]]
        y2.scale <- obj[["y32.scale"]]
    } else {
        stop("Please give a valid level: {NULL, P, C11, C21}!")
    }

    ## extract graphics-parameters
    if(!is.null(y2.lim)) {
        xaxis <- obj[["xaxis"]]
        x.stretch <- obj[["x.stretch"]]
        y.max <- y2.lim[2]
        y.scale <- y2.scale
    }

    ## transform to data frame
    df <- as.data.frame(rawdata)

    ## get graphical parameters
    pars <- getEventParameters()["IED", ]

    ## extract layer relevant data and bring in graphics form
    data <- subset(x = df, subset = Type %in% c("PR"))

    ## aggregate raw data to timeaxis dates
    ## ytd ...
    if(nrow(data)>0) {
        ## extract interest payment data (since we want to stack the two)
        ipData <- subset(x = df, subset = Type %in% c("IP"))
        ipData <- ipData[as.character(ipData$Date) %in% as.character(data$Date), ]

        ## prepare x and y positions of cashflows
        yStart <- y.scale * (abs(data$Value) + abs(ipData$Value))
        yStart[which(data$Value<0)] <- y.scale * abs(ipData$Value)
        yEnd <- y.scale * (abs(data$Value) + abs(ipData$Value))
        yEnd[which(data$Value>0)] <- y.scale * abs(ipData$Value)
        xStart <- as.numeric(as.timeDate(data$Date))
        xEnd <- as.numeric(as.timeDate(data$Date))
        prData <- data.frame(x0 = xaxis[1] + x.stretch * cumsum(diff(c(xaxis[1], xStart))),
                             x1 = xaxis[1] + x.stretch * cumsum(diff(c(xaxis[1], xEnd))),
                             yStart = yStart, yEnd = yEnd, Type = data$Type,
                             lty = pars$linetype,
                             lwd = pars$linewidth,
                             col = pars$color)
        ## prepare x and y positions of event text
        ## we always want to have the event name written above the arrow,
        ## no matter what direction it points to (in/outflow). Since, either
        ## yStart or yEnd of an arrow must be 0 by definition, we use their sum
        text <- as.character(prData$Type)
        x.pos <- prData$x0
        y.pos <- yStart + yEnd + y.scale*y.max/15
        ## do only draw arrows for events with values > 0
        prData <- subset(x = prData, subset = yStart != yEnd)
        ## add event text and cashflows (arrows) to the graphic object
        obj[["text"]][[length(obj[["text"]])+1]] <-
            data.frame(x = x.pos, y = y.pos, labels = text, cex = 0.8)
        obj[["arrows"]][[length(obj[["arrows"]])+1]] <- prData
        obj[["events"]] <- c(obj[["events"]], "PR")
    }

    ## return the updated object
    return(obj)

}

addCapitalisationLayer <- function(obj, rawdata, axis) {

    ## what is the axis to draw on?
    if(axis == "NULL") {
        y2.lim <- obj[["y2.lim"]]
        y2.scale <- obj[["y2.scale"]]
    } else if(axis == "P") {
        y2.lim <- obj[["y12.lim"]]
        y2.scale <- obj[["y12.scale"]]
    } else if(axis == "C1") {
        y2.lim <- obj[["y22.lim"]]
        y2.scale <- obj[["y22.scale"]]
    } else if(axis == "C2") {
        y2.lim <- obj[["y32.lim"]]
        y2.scale <- obj[["y32.scale"]]
    } else {
        stop("Please give a valid level: {NULL, P, C11, C21}!")
    }

    ## extract graphics-parameters
    if(!is.null(y2.lim)) {
        xaxis <- obj[["xaxis"]]
        x.stretch <- obj[["x.stretch"]]
        y.max <- y2.lim[2]
        y.scale <- y2.scale
    }

    ## transform to data frame
    df <- as.data.frame(rawdata)

    ## get graphical parameters
    pars <- getEventParameters()["IPCI", ]

    ## extract layer relevant data and bring in graphics form
    data <- subset(x = df, subset = Type %in% c("IPCI"))
    ## aggregate raw data to timeaxis dates
    ## ytd ...
    if(nrow(data)>0) {
        ## prepare x and y positions of cashflows
        yStart <- y.scale * abs(data$Value)
        yStart[which(data$Value<0)] <- 0
        yEnd <- y.scale * abs(data$Value)
        yEnd[which(data$Value>0)] <- 0
        xStart <- as.numeric(as.timeDate(data$Date))
        xEnd <- as.numeric(as.timeDate(data$Date))
        ipciData <- data.frame(x0 = xaxis[1] + x.stretch * cumsum(diff(c(xaxis[1], xStart))),
                               x1 = xaxis[1] + x.stretch * cumsum(diff(c(xaxis[1], xEnd))),
                               yStart = yStart, yEnd = yEnd, Type = data$Type,
                               lty = pars$linetype,
                               lwd = pars$linewidth,
                               col = pars$color)
        ## prepare x and y positions of event text
        ## we always want to have the event name written above the arrow,
        ## no matter what direction it points to (in/outflow). Since, either
        ## yStart or yEnd of an arrow must be 0 by definition, we use their sum
        text <- as.character(ipciData$Type)
        x.pos <- ipciData$x0
        y.pos <- yStart + yEnd + y.scale*y.max/15
        ## do only draw arrows for events with values > 0
        ipciData <- subset(x = ipciData, subset = yStart != yEnd)
        ## add event text and cashflows (arrows) to the graphic object
        obj[["text"]][[length(obj[["text"]])+1]] <-
            data.frame(x = x.pos, y = y.pos, labels = text, cex = 0.8)
        obj[["arrows"]][[length(obj[["arrows"]])+1]] <- ipciData
        obj[["events"]] <- c(obj[["events"]], "IPCI")
    }

    ## return updated graphic object
    return(obj)
}


addInterestAccrualsLayer <- function(obj, rawdata, axis) {
    ## what is the axis to draw on?
    if(axis == "NULL") {
        y2.lim <- obj[["y2.lim"]]
        y2.scale <- obj[["y2.scale"]]
    } else if(axis == "P") {
        y2.lim <- obj[["y12.lim"]]
        y2.scale <- obj[["y12.scale"]]
    } else if(axis == "C1") {
        y2.lim <- obj[["y22.lim"]]
        y2.scale <- obj[["y22.scale"]]
    } else if(axis == "C2") {
        y2.lim <- obj[["y32.lim"]]
        y2.scale <- obj[["y32.scale"]]
    } else {
        stop("Please give a valid level: {NULL, P, C11, C21}!")
    }

    ## transform to data frame
    df <- as.data.frame(rawdata)

    ## extract graphics-parameters and if secondary y-axis should be drawn,
    ## prepare
    if(!is.null(y2.lim)) {
        xaxis <- obj[["xaxis"]]
        x.stretch <- obj[["x.stretch"]]
        y.max <- y2.lim[2]
        y.scale <- y2.scale

        ## extract and prepare relevant data
        pars <- getEventParameters()["IA", ]
        subs <- c("IED", "PRD", "IP", "IPCI", "RR", "TD","ETA","ITF")
        if(!("IED" %in% df$Type | "PRD" %in% df$Type)) {
            subs <- c("AD0", subs)
        }
        data <- subset(x = df, subset = Type %in% subs)

        if(nrow(data) > 1) {
            ## for RR and TD events, replace event Value with state variable for accrued interest
            if(nrow(subset(x = data, subset = Type == "RR")) > 0){
                data[which(data$Type == "RR"), "Value"] <- data[which(data$Type == "RR"), "NominalAccrued"]

            }
            if(nrow(subset(x = data, subset = Type == "TD")) > 0){
                data[which(data$Type == "TD"), "Value"] <- data[which(data$Type == "TD"), "NominalAccrued"]

            }
            if(nrow(subset(x = data, subset = Type == "ETA")) > 0){
              data[which(data$Type == "ETA"), "Value"] <- data[which(data$Type == "ETA"), "NominalAccrued"]
            }
            if(nrow(subset(x = data, subset = Type == "ITF")) > 0){
              data[which(data$Type == "ITF"), "Value"] <- data[which(data$Type == "ITF"), "NominalAccrued"]
            }
            ## prepare line x and y coordinates
            xStart <- as.numeric(as.timeDate(data$Date[1:(nrow(data)-1)]))
            xEnd <- as.numeric(as.timeDate(data$Date[2:nrow(data)]))
            x0 <- xaxis[1] + x.stretch * cumsum(diff(c(xaxis[1], xStart)))
            x1 <- xaxis[1] + x.stretch * cumsum(diff(c(xaxis[1], xEnd)))
            yStart <- y.scale * abs(data$NominalAccrued[1:(nrow(data)-1)])
            yEnd <- y.scale * abs(data$Value[2:nrow(data)])

            ## ... bring in standard layer format
            ipacData <- data.frame(x0 = x0, x1 = x1,
                                   yStart = yStart, yEnd = yEnd,
                                   Type = data[1:(nrow(data)-1), "Type"],
                                   lty = pars$linetype, lwd = pars$linewidth,
                                   col = pars$color)
            ## add accrual lines
            obj[["lines"]][[length(obj[["lines"]])+1]] <- ipacData

            ## add accrual pseudo event if accruing is drawn
            obj[["events"]] <- c(obj[["events"]], "IA")
        }
    }
    ## return the updated object
    return(obj)

}


addRateResetLayer <- function(obj, rawdata, axis) {
    ## what is the axis to draw on?
    if(axis == "NULL") {
        y1.lim <- obj[["y.lim"]]
        y1.scale <- 1
        y.max <- y1.lim[1]
    } else if(axis == "P") {
        y1.lim <- obj[["y11.lim"]]
        y1.scale <- 1
        y.max <- y1.lim[1] * y1.scale
    } else if(axis == "C1") {
        y1.lim <- obj[["y11.lim"]]
        y1.scale <- obj[["y21.scale"]]
        y.max <- y1.lim[1] * y1.scale
        if(!is.null(obj[["y31.lim"]])) {
            y.max <- (-1) * y.max
        }
    } else if(axis == "C2") {
        y1.lim <- obj[["y11.lim"]]
        y1.scale <- obj[["y31.scale"]]
        y.max <- y1.lim[1] * (-1) * y1.scale
    } else {
        stop("Please give a valid level: {NULL, P, C11, C21}!")
    }

    ## transform to data frame
    df <- as.data.frame(rawdata)

    ## extract graphics-parameters
    xaxis <- obj[["xaxis"]]
    x.stretch <- obj[["x.stretch"]]
    y.max <- 0.33 * y.max

    ## extract and prepare relevant data
    data <- subset(x = df, subset = Type %in% c("IED", "PRD", "RR", "RRY", "TD", "MD"))
    if(nrow(subset(x = data, subset = Type %in% c("RR","RRY"))) > 0) {
        data$Value[1] <- data$NominalRate[1]
        aux <- data.frame(xStart = as.numeric(as.timeDate(data$Date[1:(nrow(data) - 1)])),
                          xEnd = as.numeric(as.timeDate(data$Date[2:nrow(data)])),
                          Value = data$Value[1:(nrow(data) - 1)],
                          Type = data$Type[1:(nrow(data) - 1)])
        ## add event text
        data <- subset(x = df, subset = Type %in% c("RR", "RRY"))
        text <- as.character(data$Type)
        x.pos <- xaxis[1] + x.stretch * cumsum(diff(c(xaxis[1], as.numeric(as.timeDate(data$Date)))))
        y.pos <- y.max
        obj[["text"]][[length(obj[["text"]])+1]] <- data.frame(x = x.pos, y = y.pos, labels = text, cex = 0.8)

        ## add rate reset cycles
        ## get graphical parameters
        pars <- getEventParameters()["RR", ]
        for(i in 1:nrow(aux)) {
            x <- aux[i, ]
            xVals <- xaxis[1] + x.stretch * cumsum(diff(c(xaxis[1], as.numeric(x[c("xStart", "xEnd")]))))
            x.eval <- subset(data.frame(x = xaxis), x > xVals[1] & x < xVals[2])[,1]
            x.std <- x.eval - min(x.eval)
            x.std <- x.std / max(x.std)
            y.sin <- y.max * sin(x.std * pi)
            rrData <- data.frame(x = x.eval, y = y.sin, lty = pars$linetype,
                                 lwd = pars$linewidth, col = pars$color)
            ## add to graph
            obj[["cycles"]][[length(obj[["cycles"]])+1]] <- rrData
        }
        ## add accrual event if rate resetting is drawn
        obj[["events"]] <- c(obj[["events"]], "RR")

    }

    ## return the updated object
    return(obj)
}


addDividendLayer <- function(obj, rawdata, axis) {
    ## what is the axis to draw on?
    if(axis == "NULL") {
        y2.lim <- obj[["y2.lim"]]
        y2.scale <- obj[["y2.scale"]]
    } else if(axis == "P") {
        y2.lim <- obj[["y12.lim"]]
        y2.scale <- obj[["y12.scale"]]
    } else if(axis == "C1") {
        y2.lim <- obj[["y22.lim"]]
        y2.scale <- obj[["y22.scale"]]
    } else if(axis == "C2") {
        y2.lim <- obj[["y32.lim"]]
        y2.scale <- obj[["y32.scale"]]
    } else {
        stop("Please give a valid level: {NULL, P, C11, C21}!")
    }

    ## extract graphics-parameters
    if(!is.null(y2.lim)) {
        xaxis <- obj[["xaxis"]]
        x.stretch <- obj[["x.stretch"]]
        y.max <- y2.lim[2]
        y.scale <- y2.scale
    }

    ## transform to data frame
    df <- as.data.frame(rawdata)

    ## get graphical parameters
    pars <- getEventParameters()["DV", ]

    ## extract layer relevant data and bring in graphics form
    data <- subset(x = df, subset = Type %in% c("DV"))
    ## aggregate raw data to timeaxis dates
    ## ytd ...
    if(nrow(data)>0) {
        ## prepare x and y positions of cashflows
        yStart <- y.scale * abs(data$Value)
        yStart[which(data$Value<0)] <- 0
        yEnd <- y.scale * abs(data$Value)
        yEnd[which(data$Value>0)] <- 0
        xStart <- as.numeric(as.timeDate(data$Date))
        xEnd <- as.numeric(as.timeDate(data$Date))
        dvData <- data.frame(x0 = xaxis[1] + x.stretch * cumsum(diff(c(xaxis[1], xStart))),
                             x1 = xaxis[1] + x.stretch * cumsum(diff(c(xaxis[1], xEnd))),
                             yStart = yStart, yEnd = yEnd, Type = data$Type,
                             lty = pars$linetype,
                             lwd = pars$linewidth,
                             col = pars$color)
        ## prepare x and y positions of event text
        ## we always want to have the event name written above the arrow,
        ## no matter what direction it points to (in/outflow). Since, either
        ## yStart or yEnd of an arrow must be 0 by definition, we use their sum
        text <- as.character(dvData$Type)
        x.pos <- dvData$x0
        y.pos <- yStart + yEnd + y.scale*y.max/15
        ## do only draw arrows for events with values > 0
        dvData <- subset(x = dvData, subset = yStart != yEnd)
        ## add event text and cashflows (arrows) to the graphic object
        obj[["text"]][[length(obj[["text"]])+1]] <-
            data.frame(x = x.pos, y = y.pos, labels = text, cex = 0.8)
        obj[["arrows"]][[length(obj[["arrows"]])+1]] <- dvData
        obj[["events"]] <- c(obj[["events"]], "DV")
    }

    ## return the updated object
    return(obj)

}


addMarginingLayer <- function(obj, rawdata, axis) {
    ## what is the axis to draw on?
    if(axis == "NULL") {
        y2.lim <- obj[["y2.lim"]]
        y2.scale <- obj[["y2.scale"]]
    } else if(axis == "P") {
        y2.lim <- obj[["y12.lim"]]
        y2.scale <- obj[["y12.scale"]]
    } else if(axis == "C1") {
        y2.lim <- obj[["y22.lim"]]
        y2.scale <- obj[["y22.scale"]]
    } else if(axis == "C2") {
        y2.lim <- obj[["y32.lim"]]
        y2.scale <- obj[["y32.scale"]]
    } else {
        stop("Please give a valid level: {NULL, P, C11, C21}!")
    }

    ## extract graphics-parameters
    if(!is.null(y2.lim)) {
        xaxis <- obj[["xaxis"]]
        x.stretch <- obj[["x.stretch"]]
        y.max <- y2.lim[2]
        y.min <- y2.lim[1]
        y.scale <- y2.scale
    }

    ## transform to data frame
    df <- as.data.frame(rawdata)

    ## get graphical parameters
    pars <- getEventParameters()["MR", ]

    ## extract layer relevant data and bring in graphics form
    data <- subset(x = df, subset = Type %in% c("MR"))
    ## aggregate raw data to timeaxis dates
    ## ytd ...
    if(nrow(data)>0) {
        ## prepare x and y positions of cashflows
        yStart <- y.scale * abs(data$Value)
        yStart[which(data$Value<0)] <- 0
        yEnd <- y.scale * abs(data$Value)
        yEnd[which(data$Value>0)] <- 0
        xStart <- as.numeric(as.timeDate(data$Date))
        xEnd <- as.numeric(as.timeDate(data$Date))
        mrData <- data.frame(x0 = xaxis[1] + x.stretch * cumsum(diff(c(xaxis[1], xStart))),
                             x1 = xaxis[1] + x.stretch * cumsum(diff(c(xaxis[1], xEnd))),
                             yStart = yStart, yEnd = yEnd, Type = data$Type,
                             lty = pars$linetype,
                             lwd = pars$linewidth,
                             col = pars$color)
        ## prepare x and y positions of event text
        ## we always want to have the event name written above the arrow,
        ## no matter what direction it points to (in/outflow). Since, either
        ## yStart or yEnd of an arrow must be 0 by definition, we use their sum
        text <- as.character(mrData$Type)
        x.pos <- mrData$x0
        y.pos <- yStart + yEnd + y.scale*y.max/15
        ## do only draw arrows for events with values > 0
        mrData <- subset(x = mrData, subset = yStart != yEnd)
        ## STD event gets a different y position (same as notional events)
        if("STD" %in% text) {
            y.pos[which(text == "STD")] <- y.min / 2
            obj[["events"]] <- c(obj[["events"]], "STD")
        }
        ## do only draw arrows for events with values > 0
        mrData <- subset(x = mrData, subset = yStart != yEnd)

        ## add event text and cashflows (arrows) to the graphic object
        obj[["text"]][[length(obj[["text"]])+1]] <-
            data.frame(x = x.pos, y = y.pos, labels = text, cex = 0.8)

        obj[["arrows"]][[length(obj[["arrows"]])+1]] <- mrData
        obj[["events"]] <- c(obj[["events"]], "MR")

    }

    ## return the updated object
    return(obj)
}


addChildLayers <- function(obj, childEvents, childCT, axis) {

    ## process child only if at least 1 event is in its event list!
    if(nrow(childEvents) > 0) {

        ## extract graphic object
        graph <- obj

        ## add child 1 layers according to child contract type:
        df <- as.data.frame(childEvents)
        type <- childCT
        if(tolower(gsub(" ", "", type)) %in%
           c("pam", "principalatmaturity", "ann", "annuity", "nam", "negativeamortizer",
             "lam", "linearamortizer", "lax", "exoticlinearamortizer")) { ## maturity CT

            ## add layers
            graph <- addNotionalPrincipalPaymentLayer(graph, df, axis = axis)
            graph <- addNotionalPrincipalStateLayer(graph, df, axis = axis)
            graph <- addPrincipalRedemptionLayer(graph, df, axis = axis)
            graph <- addInterestPaymentLayer(graph, df, axis = axis)
            graph <- addCapitalisationLayer(graph, df, axis = axis)
            graph <- addInterestAccrualsLayer(graph, df, axis = axis)
            graph <- addRateResetLayer(graph, df, axis = axis)
            if(axis == "C1") {
                graph[["y21.lab"]] <- "C1: Notional/Principal"
                graph[["y22.lab"]] <- "C1: Interest Payments"
            } else if(axis == "C2") {
                graph[["y31.lab"]] <- "C2: Notional/Principal"
                graph[["y32.lab"]] <- "C2: Interest Payments"
            }

        } else if(tolower(gsub(" ", "", type)) %in%
                  c("stk", "stock")) { ## obviously a Stock

            ## add layers
            graph <- addNotionalPrincipalPaymentLayer(graph, df, axis = axis)
            graph <- addDividendLayer(graph, df, axis = axis)
            if(axis == "C1") {
                graph[["y21.lab"]] <- "C1: Notional/Principal"
                graph[["y22.lab"]] <- "C1: Dividend Payments"
            } else if(axis == "C2") {
                graph[["y31.lab"]] <- "C2: Notional/Principal"
                graph[["y32.lab"]] <- "C2: Dividend Payments"
            }

        }
    }
    ## return graphic object
    return(graph)

}


getEventParameters <- function() {

    ## initialise event information
    descriptions <- c("CDD: Contract \nDeal Date",
                      "IED: Initial \nExchange Date",
                      "PRD: Purchase \nDate",
                      "IP: Interest \nPayment",
                      "Interest Accrual",
                      "IPCI: Interest \nCapitalisation",
                      "PR: Principal \nRedemption",
                      "RR: Rate \nResetting",
                      "MD: Maturity \nDate",
                      "TD: Termination \nDate",
                      "DV: Dividend \nPayment",
                      "MR: Margining \nPayment",
                      "STD: Settlement \nDate",
                      "OPPD: Option Premium \nPayment",
                      "OPXED: Option Exercise \nEnd Date",
                      "AD0: Analysis \nDate",
                      "OPS: Operational \nCashflow",
                      "DPR: Depreciation",
                      "RES: Reserves",
                      "ETA: External \nTransaction",
                      "ITF: Internal \nTransfer",
                      "NominalValue: ")
    colors <- c("black", "red", "red", "darkgreen", "darkgreen",
                "darkgreen", "red", "green", "red", "red", "blue",
                "darkblue", "darkblue", "red", "red", "black", "darkgreen",
                "darkgreen", "red", "red", "red", "red")
    linetypes <- c(1, 1, 1, 1, 2, 2, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,2,1,1,1,2)
    linewidths <- c(2, 2, 2, 1.5, 1.5, 1.5, 2, 1.5, 2, 2, 1.5, 1.5, 1.5, 2, 2, 2, 2,2,2,2,2,2)
    pars <- data.frame(description = descriptions,
                       color = as.character(colors),
                       linetype = linetypes,
                       linewidth = linewidths)
    pars$description <- as.character(descriptions)
    pars$color <- as.character(colors)
    rownames(pars) <- c("CDD", "IED", "PRD", "IP", "IA", "IPCI", "PR",
                        "RR", "MD", "TD", "DV", "MR", "STD", "OPPD", "OPXED", "AD0", 
                        "OPS","DPR","RES","ETA","ITF","NominalValue")

    return(pars)
}


## ---------------------- End of plot ------------------------------


######################## End of Methods Definition #################
wbreymann/FEMS documentation built on Dec. 8, 2022, 9:43 a.m.