Nothing
################################################# Class
setClass(
Class="ycInterExtra",
representation=representation(
matsin ="vector",
observedvalues="vector",
method="character",
typeres ="character",
coefficients="vector",
matsout ="vector",
fittedvalues="vector",
residuals="vector",
fwdrates ="vector",
UFR="numeric",
T_UFR="numeric",
extrapvalues="vector"
)
)
################################################## Getter - Setter
# maturities
setGeneric(
name="setMatsIn",
def = function(.Object, x)
{
standardGeneric("setMatsIn")
}
)
setMethod (f = "setMatsIn",
signature = "ycInterExtra",
definition =
function(.Object, x)
{
.Object@matsin <- x
return(.Object)
})
setGeneric(
name="getMatsIn",
def = function(.Object)
{
standardGeneric("getMatsIn")
}
)
setMethod (f = "getMatsIn",
signature = "ycInterExtra",
definition =
function(.Object)
{
return(.Object@matsin)
})
setGeneric(
name="setMatsOut",
def = function(.Object, x)
{
standardGeneric("setMatsOut")
}
)
setMethod (f = "setMatsOut",
signature = "ycInterExtra",
definition =
function(.Object, x)
{
.Object@matsout <- x
return(.Object)
})
setGeneric(
name="getMatsOut",
def = function(.Object)
{
standardGeneric("getMatsOut")
}
)
setMethod (f = "getMatsOut",
signature = "ycInterExtra",
definition =
function(.Object)
{
return(.Object@matsout)
})
# observed values
setGeneric(
name="setObservedvalues",
def = function(.Object, x)
{
standardGeneric("setObservedvalues")
}
)
setMethod (f = "setObservedvalues",
signature = "ycInterExtra",
definition =
function(.Object, x)
{
.Object@observedvalues <- x
return(.Object)
})
setGeneric(
name="getObservedvalues",
def = function(.Object)
{
standardGeneric("getObservedvalues")
}
)
setMethod (f = "getObservedvalues",
signature = "ycInterExtra",
definition =
function(.Object)
{
return(.Object@observedvalues)
})
# coefficients
setGeneric(
name="setCoefficients",
def = function(.Object, x)
{
standardGeneric("setCoefficients")
}
)
setMethod (f = "setCoefficients",
signature = "ycInterExtra",
definition =
function(.Object, x)
{
.Object@coefficients <- unlist(x)
return(.Object)
})
setGeneric(
name="getCoefficients",
def = function(.Object)
{
standardGeneric("getCoefficients")
}
)
setMethod (f = "getCoefficients",
signature = "ycInterExtra",
definition =
function(.Object)
{
return(.Object@coefficients)
})
# residuals
setGeneric(
name="setResiduals",
def = function(.Object, x)
{
standardGeneric("setResiduals")
}
)
setMethod(f = "setResiduals",
signature = "ycInterExtra",
definition =
function(.Object, x)
{
.Object@residuals <- x
return(.Object)
})
setGeneric(
name="getResiduals",
def = function(.Object)
{
standardGeneric("getResiduals")
}
)
setMethod (f = "getResiduals",
signature = "ycInterExtra",
definition =
function(.Object)
{
return(.Object@residuals)
})
# Forward rates
setGeneric(
name="setFwdrates",
def = function(.Object, x)
{
standardGeneric("setFwdrates")
}
)
setMethod (f = "setFwdrates",
signature = "ycInterExtra",
definition =
function(.Object, x)
{
.Object@fwdrates <- x
return(.Object)
})
setGeneric(
name="getFwdrates",
def = function(.Object)
{
standardGeneric("getFwdrates")
}
)
setMethod (f = "getFwdrates",
signature = "ycInterExtra",
definition =
function(.Object)
{
return(.Object@fwdrates)
})
# fitted values
setGeneric(
name="setFittedvalues",
def = function(.Object, yM = NULL, p = NULL, matsin, matsout,
method=c("NS", "SV", "SW", "HCSPL"), typeres=c("rates", "prices"))
{
standardGeneric("setFittedvalues")
}
)
setMethod (f = "setFittedvalues",
signature = "ycInterExtra",
definition =
function(.Object, yM = NULL, p = NULL, matsin, matsout,
method=c("NS", "SV", "SW", "HCSPL"), typeres=c("rates", "prices"))
{
.Object@matsin <- matsin
.Object@matsout <- matsout
method <- match.arg(method)
typeres <- match.arg(typeres)
.Object@typeres <- typeres
.Object@method <- method
J <- length(matsout)
indicemat <- pmatch(matsin, matsout)
if ((!is.null(p) || !missing(p)) && (is.null(yM) || missing(yM)))
{
.Object <- setObservedvalues(.Object, p)
res <- ycInterpolation(p = p, matsin = matsin, matsout = matsout,
method=method, typeres=typeres)
.Object <- setCoefficients(.Object, res$coefficients)
.Object@fittedvalues <- res$values
.Object <- setFwdrates(.Object, res$fwd)
if (typeres == "prices")
{
x <- p - res$values[indicemat]
}
else
{
P <- pricefromeuribor(0, matsout, res$values)
x <- p - P[indicemat]
}
.Object <- setResiduals(.Object, x)
}
if ((is.null(p) || missing(p)) && (!is.null(yM) || !missing(yM)))
{
.Object <- setObservedvalues(.Object, yM)
res <- ycInterpolation(yM = yM, matsin = matsin, matsout = matsout,
method=method, typeres=typeres)
.Object <- setCoefficients(.Object, res$coefficients)
.Object@fittedvalues <- res$values
.Object <- setFwdrates(.Object, res$fwd)
if (typeres == "rates")
{
P <- pricefromeuribor(0, matsout, res$values)
x <- yM - res$values[indicemat]
}
else {
x <- yM - euriborfromprice(0, matsout[indicemat], res$values[indicemat])
}
.Object <- setResiduals(.Object, x)
}
return(.Object)
})
setGeneric(
name="getFittedvalues",
def = function(.Object)
{
standardGeneric("getFittedvalues")
}
)
setMethod (f = "getFittedvalues",
signature = "ycInterExtra",
definition =
function(.Object)
{
return(.Object@fittedvalues)
})
# extrapolated values
setGeneric(
name="setExtrapvalues",
def = function(.Object, yM = NULL, p = NULL, matsin, matsout,
method=c("NS", "SV", "SW"), typeres=c("rates", "prices"), UFR,
T_UFR = NULL)
{
standardGeneric("setExtrapvalues")
}
)
setMethod (f = "setExtrapvalues",
signature = "ycInterExtra",
definition =
function(.Object, yM = NULL, p = NULL, matsin, matsout,
method=c("NS", "SV", "SW"), typeres=c("rates", "prices"), UFR,
T_UFR)
{
.Object <- setMatsIn(.Object, matsin)
.Object <- setMatsOut(.Object, matsout)
method <- match.arg(method)
typeres <- match.arg(typeres)
.Object@method <- method
.Object@typeres <- typeres
.Object@UFR <- UFR
indicemat <- pmatch(matsin, matsout)
J <- length(matsout)
if(!is.null(T_UFR))
{
if ((method != "SW")) warning("unused parameter T_UFR")
.Object@T_UFR <- T_UFR
}
if (!is.null(p) && is.null(yM))
{
.Object <- setObservedvalues(.Object, p)
res <- ycExtrapolation(p = p, matsin = matsin, matsout = matsout,
method = method, typeres = typeres, UFR = UFR, T_UFR = T_UFR)
.Object@fittedvalues <- res$values
.Object <- setFwdrates(.Object, res$fwd)
if (typeres == "prices")
{
x <- p - res$values[indicemat]
}
else
{
P <- pricefromeuribor(0, matsout, res$values)
x <- p - P[indicemat]
}
.Object <- setResiduals(.Object, x)
}
if (is.null(p) && !is.null(yM))
{
.Object <- setObservedvalues(.Object, yM)
res <- ycExtrapolation(yM = yM, matsin = matsin, matsout = matsout,
method = method, typeres = typeres, UFR = UFR, T_UFR = T_UFR)
.Object@fittedvalues <- res$values
.Object <- setFwdrates(.Object, res$fwd)
if (typeres == "rates")
{
x <- yM - res$values[indicemat]
P <- pricefromeuribor(0, matsout, res$values)
}
else {
x <- yM - euriborfromprice(0, matsout[indicemat], res$values[indicemat])
}
.Object <- setResiduals(.Object, x)
}
.Object <- setCoefficients(.Object, res$coefficients)
.Object@extrapvalues <- res$values
return(.Object)
})
setGeneric(
name="getExtrapvalues",
def = function(.Object)
{
standardGeneric("getExtrapvalues")
}
)
setMethod (f = "getExtrapvalues",
signature = "ycInterExtra",
definition =
function(.Object)
{
return(.Object@extrapvalues)
})
########################################################## Fonctions de l'interface
ycinter <- function(yM = NULL, p = NULL, matsin, matsout,
method=c("NS", "SV", "SW", "HCSPL"),
typeres=c("rates", "prices"))
{
if ((missing(yM) || is.null(yM)) && (missing(p) || is.null(p))) stop("no input values")
y <- new("ycInterExtra")
method <- match.arg(method)
typeres <- match.arg(typeres)
if (!missing(yM) || !is.null(yM))
{
y <- setFittedvalues(y, yM = yM, matsin = matsin, matsout = matsout,
method=method, typeres=typeres)
}
if (!missing(p) || !is.null(p))
{
y <- setFittedvalues(y, p = p, matsin = matsin, matsout = matsout,
method=method, typeres=typeres)
}
return(y)
}
ycextra <- function(yM = NULL, p = NULL, matsin, matsout,
method=c("NS", "SV", "SW"),
typeres=c("rates", "prices"), UFR,
T_UFR = NULL)
{
if ((missing(yM) || is.null(yM)) && (missing(p) || is.null(p))) stop("no input values")
y <- new("ycInterExtra")
method <- match.arg(method)
typeres <- match.arg(typeres)
if (!missing(yM) || !is.null(yM))
{
y <- setExtrapvalues(y, yM = yM, matsin = matsin, matsout = matsout,
method=method, typeres=typeres, UFR = UFR, T_UFR = T_UFR)
}
if (!missing(p) || !is.null(p))
{
y <- setExtrapvalues(y, p = p, matsin = matsin, matsout = matsout,
method=method, typeres=typeres, UFR = UFR, T_UFR = T_UFR)
}
return(y)
}
coeffs <- function(.Object)
{
return(getCoefficients(.Object))
}
deviance <- function(.Object)
{
return(crossprod(getResiduals(.Object))[1,1])
}
residuals<- function(.Object)
{
u <- .Object@matsin
return(ts(getResiduals(.Object), deltat=u[2]-u[1]))
}
fitted<- function(.Object)
{
t <- getMatsOut(.Object)
return(ts(getFittedvalues(.Object), deltat=t[2]-t[1]))
}
ycsummary <- function(.Object)
{
y <- list(obs = .Object@observedvalues, matsin = .Object@matsin,
coeff = .Object@coefficients, fitted =.Object@fittedvalues,
matsout = .Object@matsout, resid = .Object@residuals,
typeres = .Object@typeres)
if(max(y$obs) < 0.2 && (y$typeres != "rates"))
{
y$fitted <- euriborfromprice(0, y$matsout, y$fitted)
}
if(max(y$obs) > 0.2 && (y$typeres != "prices"))
{
y$fitted <- pricefromeuribor(0, y$matsout, y$fitted)
}
n <- length(y$obs)
if (.Object@method == "SW")
{p <- length(y$coeff) - 1}
else {p <- length(y$coeff)}
cat("Residuals:", "\n")
print(summary(y$resid))
cat("\n")
cat("Coefficients:", "\n")
cat(y$coeff, "\n")
cat("\n")
# Total sum of squares
yobs <- y$obs
ybar <- mean(y$obs)
typeres <- y$typeres
u <- y$matsin
t <- y$matsout
indicemat <- pmatch(u, t)
ychapeau <- y$fitted[indicemat]
resid <- y$resid
ESS <- crossprod(rep.int(ybar, n) - ychapeau)[1,1]
SSR <- crossprod(yobs - ychapeau)[1,1]
SST <- ESS + SSR
cat("Total sum of squares:", "\n")
cat(SST, "\n")
cat("with", n - 1,"degrees of freedom","\n")
cat("\n")
cat("Explained sum of squares:", "\n")
cat(ESS, "\n")
cat("with", p - 1,"degrees of freedom","\n")
cat("\n")
cat("Residual sum of squares:", "\n")
cat(SSR, "\n")
cat("with", n - p,"degrees of freedom","\n")
cat("\n")
Rsquared <- 1 - SSR/SST
cat("Multiple R-squared ", "*", "Adjusted R-squared", "\n")
cat(Rsquared, "*", 1 - ((n-1)/(n-p))*(1 - Rsquared), "\n")
cat("\n")
if (try(shapiro.test(y$resid)$p.value, TRUE) >= 0.05 || n >= 30)
{
Fstat <- ((n-p)/(p-1))*(Rsquared/(1 - Rsquared))
suppressWarnings(cat("F-statistic:", Fstat, "on",
n - p,"and", p-1, "degrees of freedom, p-value:", pf(Fstat, n-p, p-1), "\n"))
}
}
ycplot <- function(.Object){
indicatrice <- pmatch(.Object@matsin, .Object@matsout)
par(mfrow=c(2,2))
ord <- .Object@fittedvalues
x <- .Object@observedvalues
if(.Object@typeres == "rates")
{
if (max(.Object@observedvalues) > 0.2)
{x <- euriborfromprice(0, .Object@matsin, .Object@observedvalues)}
plot(x = .Object@matsout, y = ord,
main = "(Red) Observed values and (Black) Fitted values", xlab = "Maturity",
ylab = "Yield to maturity")
points(x = .Object@matsin, y = x, col="red", pch=3)
plot(x = x, y = ord[indicatrice],
main = "Observed vs Fitted values", xlab="observed values", ylab="fitted values")
abline(0, 1, col="red")
}
else
{
if (max(.Object@observedvalues) < 0.2)
{x <- pricefromeuribor(0, .Object@matsin, .Object@observedvalues)}
plot(x = .Object@matsout, y = ord,
main = "(Red) Observed values and (Black) Fitted values", xlab = "Maturity",
ylab = "Zero-coupon price")
points(x = .Object@matsin, y = x, col="red", pch=3)
plot(x = x, y = ord[indicatrice],
main = "Observed vs Fitted values", xlab="observed values", ylab="fitted values")
abline(0, 1, col="red")
}
hist(.Object@residuals, main = paste("Histogram and density", "\n","of residuals"),
xlab = "residuals")
lines(density(.Object@residuals), col="red")
if(max(.Object@matsout) <= max(.Object@matsin))
{
qqnorm(.Object@residuals, main = "Residuals' Normal Q-Q plot")
qqline(.Object@residuals, col="red")
}
else
{
plot(forwardrates(.Object), main = "Extrapolated forward rates")
}
}
forwardrates <- function(.Object)
{
t <- .Object@matsout
return(ts(getFwdrates(.Object), deltat=t[2]-t[1]))
}
as.list <- function(.Object)
{
y <- list(matsin = .Object@matsin, obs = .Object@observedvalues, method = .Object@method, typeres = .Object@typeres,
coeff = .Object@coefficients, matsout = .Object@matsout, fitted =.Object@fittedvalues, fwdrates = .Object@fwdrates,
resid = .Object@residuals, UFR = .Object@UFR, T_UFR = .Object@T_UFR, extra = .Object@extrapvalues)
return(y)
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.