library("RQuantLib")

today <- function() {
    Sys.Date()
}

addBusDay <- function(tradedate = Sys.Date(), n.days = 3, calendar = "UnitedStates/GovernmentBond"){
    advance(calendar = calendar, dates=tradedate, n=n.days, timeUnit=0)
}

convertTenor <- function(tenor) {
    ## convert tenors of the form '1y', '2y', etc...
    ## and '1m', '2m'... into yearfrac
    month <- regexpr("([0-9]+)m", tenor, perl = T)
    year <- regexpr("([0-9]+)y", tenor, perl = T)
    if ( month != -1 ) {
        a <- attr(month, "capture.start")
        b <- a + attr(month, "capture.length") - 1
        l <- as.numeric(substr(tenor, a, b))
        return ( 30 * l )
    }else if ( year != -1) {
        a <- as.numeric(attr(year, "capture.start"))
        b <- a + attr(year, "capture.length") - 1
        l <- as.numeric(substr(tenor, a, b))
        return ( 365 * l )
    }else{
        stop("format not recognized")
    }
}

addTenor <- function(date, tenor) {
    month <- regexpr("([0-9]+)m", tenor, perl = T)
    year <- regexpr("([0-9]+)y", tenor, perl = T)
    if ( month != -1 ) {
        a <- attr(month, "capture.start")
        b <- a + attr(month, "capture.length") - 1
        l <- as.numeric(substr(tenor, a, b))
        return ( seq(date, length=2, by=paste(l,"month"))[2])
    }else if ( year != -1) {
        a <- as.numeric(attr(year, "capture.start"))
        b <- a + attr(year, "capture.length") - 1
        l <- as.numeric(substr(tenor, a,b))
        return ( seq(date, length=2, by=paste(l,"year"))[2] )
    }else{
        stop("format not recognized")
    }
}

couponSchedule <- function(nextpaydate=NULL, maturity, frequency, coupontype, currentcoupon,
                           margin, tradedate=Sys.Date(), prevpaydate=tradedate){
    ## computes the coupon schedule
    ## inputs:
    ##   nextpaydate: first payment date of the coupon schedule
    ##   maturity: last payment date of the schedule
    ##   frequency: letter specifying the frequency between "Q", "M", "B", "S" or "A"
    ## if startdate is provided, we generate the forward coupon schedule starting from that date.
    bystring <- switch(frequency,
                       Q = "3 months",
                       M = "1 month",
                       B = "2 months",
                       S = "6 months",
                       A = "12 months")

    if(is.null(bystring)){
        stop("unknown frequency")
    }
    if(is.null(nextpaydate)){
        dates <- rev(seq(maturity, tradedate, by =paste0("-", bystring)))
    }else{
        if(nextpaydate>maturity){
            dates <- maturity
        }else{
            ## weird bug with non integer dates, hence the as.Date(as.POSIXlt(.)) trick
            dates <- seq(nextpaydate, as.Date(as.POSIXlt(maturity)), by = bystring)
        }
    }
    if(length(dates)==0){
        dates <- maturity
    }else{
        if(dates[length(dates)]<maturity){
            dates <- c(dates, maturity)
        }
    }
    dates <- dates[ dates >= tradedate]
    dates <- adjust(calendar="UnitedStates/GovernmentBond", dates)
    names(dates) <- NULL
    DC <- switch(frequency,
                 S = DiscountCurve(L6m$params, L6m$tsQuotes, yearFrac(L6m$params$tradeDate, dates)),
                 Q = DiscountCurve(L3m$params, L3m$tsQuotes, yearFrac(L3m$params$tradeDate, dates)),
                 M = DiscountCurve(L1m$params, L1m$tsQuotes, yearFrac(L1m$params$tradeDate, dates)),
                 B = DiscountCurve(L2m$params, L2m$tsQuotes, yearFrac(L2m$params$tradeDate, dates)),
                 A = DiscountCurve(L12m$params, L12m$tsQuotes, yearFrac(L12m$params$tradeDate, dates)))

    if(toupper(coupontype)=="FLOAT" && !is.na(margin)){
        ## if is.na(margin) probably letter of credit
        ## we floor the coupon at the current gross rate
        coupons <- pmax(currentcoupon, DC$forwards + margin)
    }else{
        coupons <- rep(currentcoupon, length(dates))
    }
    coupons <- diff(c(0, yearFrac(prevpaydate, dates, "act/360"))) * coupons

    if(tradedate!=DC$params$tradeDate){
        df <- cumprod(exp(-DC$forwards * diff(c(0, yearFrac(tradedate, dates)))))
    }else{
        df <- DC$discounts
    }
    return( data.frame(dates=dates, coupons=coupons, df = df) )
}

IMMDate <- function(tradedate, type="next") {
    ## returns the next IMM date for a CDS, adjusted for settlement
    ## or previous one if type="prev"
    ## protection seems to be assumed at close of business day
    ## so if we trade on Friday, we're protected during the week-end
    ## matches with Bloomberg calculator
    start.protection <- tradedate + 1
    startyear <- as.numeric(format(start.protection, format="%Y"))
    startyear <- startyear - 1
    nextimmdates <- seq(as.Date(paste(startyear, 3, 20, sep="-")), length=9, by="3 months")
    if(type == "next"){
        val <- adjust(calendar = "UnitedStates/GovernmentBond",
                      nextimmdates[nextimmdates >= start.protection][1] )
    }else if(type == "prev"){
        temp <- nextimmdates[nextimmdates < start.protection]
        val <- adjust(calendar = "UnitedStates/GovernmentBond", temp[length(temp)] )
    }else{
        stop("incorrect type")
    }
    names(val) <- NULL
    return( val )
}

cdsAccrued <- function(tradedate, coupon){
    start.protection <- tradedate + 1
    return (yearFrac(IMMDate(tradedate, "prev"), start.protection, "act/360") * coupon)
}

cdsMaturity <- function(tenor, date=Sys.Date()){
    return ( IMMDate(addTenor(date, tenor)) )
}

yearFrac <- function(date1, date2, daycount="act/365") {
    switch(daycount,
           "act/365"=as.numeric( (as.Date(date2) - as.Date(date1)) / 365),
           "act/360"=as.numeric( (as.Date(date2) - as.Date(date1)) / 360) )
}

load.index <- function(index.name){
    ## load index.name into the parent environment
    require(yaml)
    indices <- yaml.load_file(file.path(root.dir, "code", "R", "index_definitions.yml"))
    indices[[index.name]]$maturity <- as.Date(indices[[index.name]]$maturity, as.Date("1970-01-01"))
    assign(index.name, indices[[index.name]], env = parent.env(environment()))
}