1+
2+ # Smith-Wilson curve -----
3+ tZC_SW <- function (yM = NULL , p = NULL , u , t , UFR ,
4+ typeres = c(" rates" " prices" T_UFR = NULL )
5+ {
6+ N <- length(u )
7+ J <- length(t )
8+
9+ fonctionsWilson <- function (t ,u ,alpha ,UFR )
10+ {
11+ N <- length(u )
12+ J <- length(t )
13+ u_mat <- matrix (rep.int(u ,J ), nrow = J , byrow = T )
14+ t_mat <- t(matrix (rep.int(t ,N ), nrow = N , byrow = T ))
15+ min_u <- u_mat * (u_mat < = t_mat ) + t_mat * (u_mat > t_mat )
16+ max_u <- u_mat + t_mat - min_u
17+ return (exp(- UFR * (u_mat + t_mat ))* (alpha * min_u - 0.5 * exp(- alpha * max_u )* (exp(alpha * min_u )- exp(- alpha * min_u ))))
18+ }
19+
20+ if ((is.null(p ) || missing(p )) && (! is.null(yM ) || ! missing(yM )))
21+ {
22+ p <- pricefromeuribor(t = 0 , T = u , L = yM )
23+ }
24+
25+ alpha <- 0.1
26+ mu <- exp(- UFR * u )
27+ W <- fonctionsWilson(u ,u ,alpha ,UFR )
28+ Xhi <- solve(W )%*% (p - mu )
29+ W_interp <- fonctionsWilson(t ,u ,alpha ,UFR )
30+ P <- exp(- UFR * t ) + W_interp %*% Xhi
31+ Fwd <- fwdrate(t [- J ], t [- 1 ], P [- J ], P [- 1 ])
32+
33+ typeres <- match.arg(typeres )
34+ if (max(t ) > max(u ))
35+ {
36+ if (missing(T_UFR )) stop(" For the extrapolation T_UFR must be provided, check the output maturities"
37+ alpha <- 0.1
38+
39+ if (max(u )+ T_UFR > max(t )) stop(" Not enough extrapolation dates. Try a lower T_UFR"
40+
41+ while (abs(Fwd [pmatch(max(u )+ T_UFR , t )]- UFR ) > = 0.0003 )
42+ {
43+ alpha <- alpha + 0.001
44+ mu <- exp(- UFR * u )
45+ W <- fonctionsWilson(u ,u ,alpha ,UFR )
46+ Xhi <- solve(W )%*% (p - mu )
47+ W_interp <- fonctionsWilson(t ,u ,alpha ,UFR )
48+ P <- exp(- UFR * t ) + W_interp %*% Xhi
49+ Fwd <- fwdrate(t [- J ], t [- 1 ], P [- J ], P [- 1 ])
50+ }
51+ }
52+
53+ if (typeres == " prices"
54+ {return (list (coefficients = list (alpha = alpha , Xhi = as.vector(Xhi )),
55+ values = as.vector(P ),
56+ fwd = Fwd ))}
57+
58+ if (typeres == " rates"
59+ {
60+ return (list (coefficients = list (alpha = alpha , Xhi = as.vector(Xhi )), values = euriborfromprice(t = 0 , T = t , ZC = P ), fwd = Fwd ))
61+ }
62+ }
63+ tZC_SW <- compiler :: cmpfun(tZC_SW )
64+
65+
66+ # Polynomial Hermite cubic spline interpolation -----
67+ hermitecubicspline <- function (yM = NULL , p = NULL , matsin , matsout ,
68+ typeres = c(" rates" " prices"
69+ {
70+ u <- matsin
71+ t <- matsout
72+
73+ if (max(t ) > max(u )) stop(" Only interpolation can be performed with cubic splines, check the output maturities"
74+
75+ if (! is.null(yM ) && ! is.null(p )) stop(" either yields OR prices must be provided"
76+
77+ if (is.null(yM ) && is.null(p )) stop(" either yields or prices must be provided"
78+
79+ if (! is.null(yM ))
80+ {Sw <- yM }
81+ else {Sw <- p }
82+
83+ n <- length(u )
84+ i <- seq_len(n )
85+ iup <- i [- 1 ]
86+ idown <- i [- n ]
87+ Delta <- diff(u )
88+ delta <- diff(Sw )
89+
90+ A <- delta / Delta
91+ A_up <- A [iup ]
92+ A_down <- A [idown ]
93+
94+ Delta_up <- Delta [iup ]
95+ Delta_down <- Delta [idown ]
96+
97+ P <- (A_up * Delta_down + A_down * Delta_up )/ (Delta_down + Delta_up )
98+ P <- c(2 * A [1 ] - P [2 ], P [! is.na(P )], 0 )
99+
100+ m <- length(t )
101+ z <- rep.int(0 , m )
102+ SWout <- rep.int(0 , m )
103+
104+ for (i in seq_len(m ))
105+ {
106+ u_down <- pmatch(floor(t [i ]),u )
107+ u_up <- pmatch(ceiling(t [i ]),u )
108+ Sw_down <- Sw [u_down ]
109+ Sw_up <- Sw [u_up ]
110+ P_down <- P [u_down ]
111+ P_up <- P [u_up ]
112+ Delta_down <- Delta [u_down ]
113+ Delta_up <- Delta [u_up ]
114+
115+ if (Sw_down != Sw_up )
116+ {
117+ z <- (t [i ] - u_down )/ (u_up - u_down )
118+ SWout [i ] <- Sw_down * ((1 - z )^ 3 ) + (3 * Sw_down + Delta_down * P_down )*
119+ ((1 - z )^ 2 )* z + (3 * Sw_up - Delta_down * P_up )* (1 - z )* (z ^ 2 ) +
120+ Sw_up * (z ^ 3 )
121+ }
122+ else
123+ {
124+ SWout [i ] <- Sw_down
125+ }
126+ }
127+
128+ if (typeres == " rates"
129+ {P <- pricefromeuribor(0 , t , SWout )}
130+ else {P <- SWout }
131+
132+ Fwd <- fwdrate(t [- m ], t [- 1 ], P [- m ], P [- 1 ])
133+
134+ if ((! is.null(yM ) && typeres == " rates" || (! is.null(p ) && typeres == " prices"
135+ {return (list (coefficients = NA , values = SWout , fwd = Fwd ))}
136+
137+ if (! is.null(yM ) && typeres == " prices"
138+ {
139+ return (list (coefficients = NA , values = pricefromeuribor(0 , t , SWout ), fwd = Fwd ))
140+ }
141+
142+ if (! is.null(p ) && typeres == " rates"
143+ {
144+ return (list (coefficients = NA , values = euriborfromprice(0 , t , SWout ), fwd = Fwd ))
145+ }
146+ }
147+ hermitecubicspline <- compiler :: cmpfun(hermitecubicspline )
148+
149+ # utils -----
150+
151+ # ######### Tools
152+ # simply coumpounded euribor rate
153+ euriborfromprice <- function (t , T , ZC )
154+ {
155+ # Brigo P. 7
156+ tau <- T - t
157+ return (as.vector((1 / ZC - 1 )/ tau ))
158+ }
159+ euriborfromprice <- compiler :: cmpfun(euriborfromprice )
160+
161+
162+ # simply coumpounded zero-coupon price
163+ pricefromeuribor <- function (t , T , L )
164+ {
165+ # Brigo P. 7
166+ tau <- T - t
167+ return (as.vector(1 / (1 + L * tau )))
168+ }
169+ pricefromeuribor <- compiler :: cmpfun(pricefromeuribor )
170+
171+ # simply coumpounded forward rate
172+ fwdrate <- function (T_ , S , ZC_T , ZC_S )
173+ {
174+ # Brigo P. 12
175+ tau <- S - T_
176+ return ((ZC_T / ZC_S - 1 )/ tau )
177+ }
178+ fwdrate <- compiler :: cmpfun(fwdrate )
0 commit comments