aboutsummaryrefslogtreecommitdiffstats
path: root/R/calibration.R
blob: c16cdaca18c9e19becd3ba9868a8d3a438d62233 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
source("cds_functions_generic.R")

buildSC <- function(quote, cs, cdsdates){
    SC <- new("creditcurve",
              recovery=quote$recovery,
              startdate=tradedate,
              issuer=quote$ticker)
    quotes <- data.frame(maturity=cdsdates, upfront = quote$upfront,
                         running=quote$running)
    SC@curve <- cdshazardrate(quotes, SC@recovery, tradedate, cs)
    return( SC )
}

get.cdsSchedule <- function(tradedate, indexmaturity){
    cdsdates <- as.Date(character(0))
    for(tenor in paste0(c(1:5, 7,10), "y")){
        newdate <- cdsMaturity(tenor, date=tradedate)
        cdsdates <- c(cdsdates, newdate)
        if(newdate>=indexmaturity){
            break
        }
    }
    return( list(cs=couponSchedule(IMMDate(tradedate, noadj=TRUE), cdsdates[length(cdsdates)], "Q", "FIXED",
                     1, tradedate, IMMDate(tradedate, "prev")), cdsdates=cdsdates) )
}

set.singlenamesdata <- function(index, tradedate){
    cds.cs <- get.cdsSchedule(tradedate, index$maturity)
    quotes <- get.indexquotes(index$name, tradedate)
    tenor <- names(cds.cs$cdsdates)
    index$portfolio <- list()
    for(i in seq_along(quotes$tickers)){
        if(quotes$ticker[i] %in% c("IACI", "TITANC")){
            quotes$spread_curve[i,] <- rep(0.001,8)
            quotes$upfront_curve[i,] <- rep(0,8)
            quotes$recovery[i,] <- rep(0.4,8)
        }
        quotes$upfront_curve[i, tenor] <- pmax(-yearFrac(tradedate+2,cds.cs$cdsdates)*
                                               quotes$spread_curve[i, tenor]*1e-2,
                                               quotes$upfront_curve[i, tenor])
        quote <- list(ticker = quotes$ticker[i],
                      running = quotes$spread_curve[i, tenor] * 1e-4,
                      upfront = quotes$upfront_curve[i, tenor] * 0.01,
                      recovery = as.double(quotes$recovery[i,tenor][1]))
        index$portfolio <- c(index$portfolio, buildSC(quote, cds.cs$cs, cds.cs$cdsdates))
    }
    index$issuerweights <- rep(1/length(index$portfolio), length(index$portfolio))
    index$recov <- sapply(index$portfolio, attr, "recovery")
    return( index )
}

set.tranchedata <- function(index, tradedate){
    temp <- get.tranchequotes(index$name, index$tenor, tradedate)
    index$quotes <- data.frame(maturity=index$maturity,
                               refspread=temp$indexrefspread[1],
                               refprice=temp$indexrefprice[1])
    if(index$name=="ig19" || index$name=="ig21"){
        index$quotes$spread <- 0.01
    }else{
        index$quotes$spread <- index$quotes$refspread*1e-4
    }
    index$cs <- couponSchedule(IMMDate(tradedate, noadj=TRUE), index$maturity,"Q", "FIXED", 1,
                               0, tradedate, IMMDate(tradedate, "prev"))
    if(!is.na(index$quotes$refprice) && index$quotes$refprice != 0){
        index$quotes$price <- index$quotes$refprice/100
    }else{
        ##rewrite as a snac function
        sc <- new("flatcurve", h=index$quotes$refspread[1]*1e-4/(1-index$recovery))
        startdate <- tradedate + 1
        cds.pv <- couponleg(index$cs, sc, startdate)*index$quotes$spread -
            defaultleg(index$cs, sc, index$recovery, startdate)
        index$quotes$price <- 1 + cds.pv - cdsAccrued(tradedate, index$quotes$spread[1])
    }
    tweak <- tweakcurves(index, tradedate)
    index$portfolio <- NULL
    index <- c(index, tweak)
    index$defaultprob <- 1 - SPmatrix(index$portfolio, length(index$cs$dates))
    negprob <- which(index$defaultprob<0, arr.ind=T)
    if(nrow(negprob) > 0){
        stop(paste(index$portfolio[[negprob[1,1]]]@issuer, "has negative probability, check single names data"))
    }
    K <- c(0, temp$detach/100)
    index$K.orig <- K
    index$K <- adjust.attachments(K, index$loss, index$factor)

    ## compute dirty protection price
    accrued <- cdsAccrued(tradedate, temp$trancherunningmid*1e-4)
    if(length(grep("hy", index$name, ignore.case=TRUE))>0){
        dirtyquotes <- 1 - temp$trancheupfrontmid/100 - accrued
    }else{
        dirtyquotes <- temp$trancheupfrontmid/100 - accrued
    }
    index$tranches <- data.frame(upfront=temp$trancheupfrontmid,
                                 running=temp$trancherunningmid * 1e-4,
                                 quotes=dirtyquotes,
                                 mkt.delta=temp$tranchedelta,
                                 row.names=paste(index$K.orig[-length(index$K.orig)]*100,
                                     index$K.orig[-1]*100, sep="-"))
    return( index )
}

build.skew <- function(index, type="bottomup"){
    require(lossdistrib)
    aux <- function(rho, index, K, quote, spread, complement){
        temp <- BCtranche.legs(index, K, rho, complement)
        return(abs(temp$pl+temp$cl*spread + quote))
    }
     rhovec <- rep(NA, length(index$K))
    dK <- diff(index$K)
    if(type=="bottomup"){
        for(j in 1:(length(dK)-1)){
            ##use the current tranche coupon
            ## we compute the 0-index$K[j+1] equivalent quote using the coupon of the jth quote
            tranchepv <- BCtranche.legs(index, index$K[j], rhovec[j])
            q <- index$tranches$quotes[j] * dK[j] -
                tranchepv$pl - tranchepv$cl*index$tranches$running[j]
            rho <- optimize(aux, interval=c(0,1), index=index, K=index$K[j+1], quote=q,
                            spread=index$tranches$running[j], complement=FALSE)$minimum
            rhovec[j+1] <- rho
        }
    }else if(type=="topdown"){
        for(j in length(dK):2){
            tranchepv <- BCtranche.legs(index, index$K[j+1], rhovec[j+1], complement=TRUE)
            q <- index$tranche.quotes[j] * dK[j] -
                tranchepv$pl - tranchepv$cl * index$tranches$running[j]
            rho <- optimize(aux, interval=c(0,1), index=index, K=index$K[j], quote=q,
                            spread=index$tranches$running[j], complement=TRUE)$minimum
            rhovec[j] <- rho
        }
    }
    return( rhovec )
}

build.MFdist <- function(index, type="bottomup", tol=1e-2){
    index$w.mod <- index$w
    p <- index$defaultprob
    n.credit <- length(index$issuerweights)
    rho <- rep(0.45, n.credit)
    result <- matrix(0, 4, n.int)
    n.tranches <- length(index$K)-1
    err <- Inf
    if(type=="bottomup"){
        select <- 1:(n.tranches-1)
    }else if(type=="topdown"){
        select <- 2:n.tranches
    }
    while(err > tol){
        Rstoch <- MFrecovery(index, p)
        L <- array(0, dim=c(index$N, n.int, ncol(index$defaultprob)))
        R <- array(0, dim=c(index$N, n.int, ncol(index$defaultprob)))
        for(t in 1:ncol(index$defaultprob)){
            S <- 1 - Rstoch[,,t]
            L[,,t] <- lossdistCZ(p[,t], index$issuerweights, S, index$N, 0, rho, index$Z)
            R[,,t] <- lossdistCZ(p[,t], index$issuerweights, 1-S, index$N, 0, rho, index$Z)
        }
        for(i in 1:n.int){
            dist <- list(L=L[,i,], R=R[,i,])
            result[,i] <- MFtranche.pv(index, dist, protection=TRUE)$bp
        }
        ## solve the optimization problem
        program <- KLfit(result[select,], index$w, index$tranches$quotes[select])

        err <- 0
        for(i in 1:n.credit){
            for(j in 1:ncol(p)){
                err <- err + abs(crossprod(shockprob(p[i,j], rho[i],
                                                     index$Z), program$weight) - index$defaultprob[i,j])
            }
        }

        ## update the new probabilities
        p <- MFupdate.probC(index$Z, program$weight, rho, index$defaultprob)

        index$w.mod <- program$weight
        cat("=")
    }
    cat("\n")
    return(index$w.mod)
}