library("RQuantLib")
library("stringr")

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

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

convertTenor <- function(tenor) {
    ## convert tenors of the form '1y', '2y', etc...
    ## and '1m', '2m'... into yearfrac
    match <- str_match(tenor, "([0-9]+)(m|y)")
    if ( match[3] == "m" ) {
        return ( 30 * as.integer(match[2]) )
    }else if ( match[3]=="y") {
        return ( 365 * as.integer(match[2]) )
    }else{
        stop("format not recognized")
    }
}

addTenor <- function(date, tenor) {
    match <- str_match(tenor, "([0-9]+)(m|y)")
    if ( match[3]=="m") {
        return ( seq(date, length=2, by=paste(match[2],"month"))[2])
    }else if ( match[3]=="y") {
        return ( seq(date, length=2, by=paste(match[2],"year"))[2] )
    }else{
        stop("format not recognized")
    }
}

couponSchedule <- function(nextpaydate=NULL, maturity,
                           frequency=c("Quarterly", "Monthly", "Bimonthly", "Semiannual", "Annual"),
                           coupontype=c("FLOAT", "FIXED"), currentcoupon,
                           margin, tradedate=Sys.Date(), prevpaydate=tradedate,
                           liborfloor){
    ## 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.
    frequency <- match.arg(frequency)
    coupontype <- if (is.na(coupontype)) "FLOAT" else match.arg(coupontype)
    bystring <- switch(frequency,
                       Quarterly = "3 months",
                       Monthly = "1 month",
                       Bimonthly = "2 months",
                       Semiannual = "6 months",
                       Annual = "12 months")

    if(is.null(bystring)) {
        stop("unknown frequency")
    }
    dates <-
        if(is.null(nextpaydate)){
            rev(seq(maturity, tradedate, by =paste0("-", bystring)))
        } else {
            if(nextpaydate>maturity) {
                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)
            }
        }
    dates <- dates[dates >= tradedate]
    ## we want to make sure maturity is last date
    if(length(dates) == 0 || dates[length(dates)] < maturity){
        dates <- c(dates, maturity)
    }
    unadj.dates <- dates
    if(length(dates) > 1) {
        cal <- Calendar$new("UnitedStates/GovernmentBond")
        dates[-length(dates)] <- cal$adjust(dates[-length(dates)])
    }
    names(dates) <- NULL

    period <- switch(frequency,
                     Semiannual = "6m",
                     Quarterly = "3m",
                     Monthly = "1m",
                     Bimonthly = "2m",
                     Annual = "1y")
    forwards <- YC$forwardRate(dates, period)
    if(coupontype == "FLOAT" && !is.na(margin)) {
        ## if is.na(margin) probably letter of credit
        ## we floor the coupon at the current gross rate
        coupons <- if( missing(liborfloor) ) {
                       if( is.na(currentcoupon) ) {
                           forwards + margin
                       } else {
                           pmax(currentcoupon, forwards + margin)
                       }
                   } else {
                       pmax(forwards, liborfloor) + margin
                   }
    } else {
        coupons <- rep(currentcoupon, length(dates))
    }
    yf <- diff(c(0, yearFrac(prevpaydate, dates, "act/360")))
    #the last accrued period includes the maturity date
    yf[length(yf)] <- yf[length(yf)]+1/360
    coupons <- yf * coupons

    if(tradedate != YC$referenceDate){
        df <- cumprod(exp(-forwards * diff(c(0, yearFrac(tradedate, dates)))))
    }else{
        df <- YC$discount(dates)
    }
    return( data.frame(dates=dates, unadj.dates = unadj.dates, coupons=coupons, df = df) )
}

IMMDate <- function(tradedate, type=c("next", "prev"), noadj=FALSE) {
    ## 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
    type <- match.arg(type)
    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 <- nextimmdates[nextimmdates >= start.protection][1]
    }else if(type == "prev"){
        temp <- nextimmdates[nextimmdates < start.protection]
        val <- temp[length(temp)]

    }else{
        stop("incorrect type")
    }
    if(!noadj){
        cal <- Calendar$new("UnitedStates/GovernmentBond")
        cal$adjust(val)
    }
    names(val) <- NULL
    return( val )
}

IMMDate2 <- function(tradedate, tenor, noadj=FALSE) {
    ## 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
    previmmdates <- seq(as.Date(paste(startyear, 3, 20, sep="-")), length=5, by="6 months")
    ## firstimmdate
    temp <- previmmdates[previmmdates < start.protection]
    firstimmdate <- temp[length(temp)]
    maturity <- addTenor(addTenor(firstimmdate, tenor), "3m")
    if(!noadj){
        cal <- Calendar$new("UnitedStates/GovernmentBond")
        maturity <- cal$adjust( maturity )
    }
    names(maturity) <- NULL
    return( maturity )
}

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

cdsMaturity <- function(tenor, date=Sys.Date()){
    ## before December 20, 2015, single name cds rolled quarterly
    if(date < as.Date("2015-12-20")){
        r <- IMMDate(addTenor(date, tenor))
    }else{
        r <- IMMDate2(date, tenor, noadj=T)

    }
    names(r) <- tenor
    return ( r )
}

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