324 lines
10 KiB
Text
324 lines
10 KiB
Text
|
|
||
|
|
R version 2.15.2 (2012-10-26) -- "Trick or Treat"
|
||
|
|
Copyright (C) 2012 The R Foundation for Statistical Computing
|
||
|
|
ISBN 3-900051-07-0
|
||
|
|
Platform: x86_64-pc-linux-gnu (64-bit)
|
||
|
|
|
||
|
|
R est un logiciel libre livré sans AUCUNE GARANTIE.
|
||
|
|
Vous pouvez le redistribuer sous certaines conditions.
|
||
|
|
Tapez 'license()' ou 'licence()' pour plus de détails.
|
||
|
|
|
||
|
|
R est un projet collaboratif avec de nombreux contributeurs.
|
||
|
|
Tapez 'contributors()' pour plus d'information et
|
||
|
|
'citation()' pour la façon de le citer dans les publications.
|
||
|
|
|
||
|
|
Tapez 'demo()' pour des démonstrations, 'help()' pour l'aide
|
||
|
|
en ligne ou 'help.start()' pour obtenir l'aide au format HTML.
|
||
|
|
Tapez 'q()' pour quitter R.
|
||
|
|
|
||
|
|
[Sauvegarde de la session précédente restaurée]
|
||
|
|
|
||
|
|
> ## general methods of moments (GMM)
|
||
|
|
> library(MASS)
|
||
|
|
>
|
||
|
|
> MMGpoidsNW <- function(param,modele)
|
||
|
|
+ {
|
||
|
|
+ donnees <- modele$donnees
|
||
|
|
+ q <- modele$q
|
||
|
|
+ donneesF <- donnees[-1]
|
||
|
|
+ donneesL <- donnees[-length(donnees)]
|
||
|
|
+ deltaTemps <- modele$deltaTemps
|
||
|
|
+ a <- param[1]
|
||
|
|
+ b <- param[2]
|
||
|
|
+ Gamma <- array(0,c(4,4,q+1))
|
||
|
|
+ if(modele$nomModele=="CKLS")
|
||
|
|
+ {
|
||
|
|
+ sigma <- param[3]
|
||
|
|
+ gamma <- param[4]
|
||
|
|
+ g1t <- donneesF - a - b * donneesL
|
||
|
|
+ g2t <- (donneesF - a - b * donneesL) ^ 2 - sigma^2 * donneesL ^ (2*gamma) *
|
||
|
|
+ deltaTemps
|
||
|
|
+ g3t <- (donneesF - a - b * donneesL) * donneesL
|
||
|
|
+ g4t <- ((donneesF - a - b * donneesL) ^ 2 - sigma ^ 2 * donneesL ^ (2*gamma) *
|
||
|
|
+ deltaTemps) * donneesL
|
||
|
|
+ }
|
||
|
|
+
|
||
|
|
+ if(modele$nomModele=="CIR")
|
||
|
|
+ {
|
||
|
|
+ sigma <- param[3]
|
||
|
|
+ g1t <- donneesF - a - b * donneesL
|
||
|
|
+ g2t <- (donneesF - a - b * donneesL) ^ 2 - sigma ^ 2 * donneesL * deltaTemps
|
||
|
|
+ g3t <- (donneesF - a - b * donneesL) * donneesL
|
||
|
|
+ g4t <- ((donneesF - a - b * donneesL) ^ 2 - sigma ^ 2 * donneesL * deltaTemps) *
|
||
|
|
+ donneesL
|
||
|
|
+ }
|
||
|
|
+
|
||
|
|
+ if(modele$nomModele=="Vasicek")
|
||
|
|
+ {
|
||
|
|
+ sigma <- param[3]
|
||
|
|
+ g1t <- donneesF - a - b * donneesL
|
||
|
|
+ g2t <- (donneesF - a - b * donneesL) ^ 2 - sigma ^ 2 * deltaTemps
|
||
|
|
+ g3t <- (donneesF - a - b * donneesL) * donneesL
|
||
|
|
+ g4t <- ((donneesF - a - b * donneesL) ^ 2 - sigma ^ 2 * deltaTemps) * donneesL
|
||
|
|
+ }
|
||
|
|
+ gt <- cbind(g1t,g2t,g3t,g4t)
|
||
|
|
+ n <- length(g1t)
|
||
|
|
+ ## en attendant
|
||
|
|
+ #W <- solve(cov(gt))
|
||
|
|
+ ## Newey-West
|
||
|
|
+ gtc <- apply(gt,2,function(x) x-mean(x))
|
||
|
|
+ for(v in 0:q)
|
||
|
|
+ {
|
||
|
|
+ gtF <- gtc[(1+v):n,]
|
||
|
|
+ gtL <- gtc[1:(n-v),]
|
||
|
|
+ Gamma[,,(v+1)] <- t(gtF) %*% gtL / n
|
||
|
|
+ }
|
||
|
|
+ S <- Gamma[,,1]
|
||
|
|
+ for(v in 1:q)
|
||
|
|
+ {
|
||
|
|
+ Snext <- (1-v/(q+1)) * (Gamma[,,v+1] + t(Gamma[,,v+1]))
|
||
|
|
+ S <- S+Snext
|
||
|
|
+ }
|
||
|
|
+ W <- ginv(S)
|
||
|
|
+ }
|
||
|
|
>
|
||
|
|
> MomentsJacobien <- function(param, modele)
|
||
|
|
+ {
|
||
|
|
+ donnees <- modele$donnees
|
||
|
|
+ donneesF <- donnees[-1]
|
||
|
|
+ donneesL <- donnees[-length(donnees)]
|
||
|
|
+ n <- length(donneesL)
|
||
|
|
+ deltaTemps <- modele$deltaTemps
|
||
|
|
+ if(modele$nomModele=="CKLS")
|
||
|
|
+ {
|
||
|
|
+ a <- param[1]
|
||
|
|
+ b <- param[2]
|
||
|
|
+ sigma <- param[3]
|
||
|
|
+ gamma <- param[4]
|
||
|
|
+
|
||
|
|
+ g1a <- -n
|
||
|
|
+ g2a <- -2*sum(donneesF - a - b*donneesL)
|
||
|
|
+ g3a <- -sum(donneesL)
|
||
|
|
+ g4a <- -2*sum((donneesF - a - b*donneesL)*donneesL)
|
||
|
|
+
|
||
|
|
+ g1b <- -sum(donneesL)
|
||
|
|
+ g2b <- -2*sum((donneesF - a - b*donneesL)*donneesL)
|
||
|
|
+ g3b <- -sum(donneesL^2)
|
||
|
|
+ g4b <- -2*sum((donneesF - a - b*donneesL)*donneesL^2)
|
||
|
|
+
|
||
|
|
+ g1s <- 0
|
||
|
|
+ g2s <- -deltaTemps*sum(donneesL^(2*gamma))
|
||
|
|
+ g3s <- 0
|
||
|
|
+ g4s <- -deltaTemps*sum(donneesL^(2*gamma+1))
|
||
|
|
+
|
||
|
|
+ g1g <- 0
|
||
|
|
+ g2g <- -2*sigma^2*deltaTemps*sum(log(donneesL)*donneesL^(2*gamma))
|
||
|
|
+ g3g <- 0
|
||
|
|
+ g4g <- -2*sigma^2*deltaTemps*sum(log(donneesL)*donneesL^(2*gamma+1))
|
||
|
|
+
|
||
|
|
+ d <- cbind(c(g1a, g1b, g1s, g1g),
|
||
|
|
+ c(g2a, g2b, g2s, g2g),
|
||
|
|
+ c(g3a, g3b, g3s, g3g),
|
||
|
|
+ c(g4a, g4b, g4s, g4g))/n
|
||
|
|
+ }
|
||
|
|
+ if(modele$nomModele=="CIR")
|
||
|
|
+ {
|
||
|
|
+ a <- param[1]
|
||
|
|
+ b <- param[2]
|
||
|
|
+
|
||
|
|
+ g1a <- -n
|
||
|
|
+ g2a <- -2*sum(donneesF - a - b*donneesL)
|
||
|
|
+ g3a <- -sum(donneesL)
|
||
|
|
+ g4a <- -2*sum((donneesF - a - b*donneesL)*donneesL)
|
||
|
|
+
|
||
|
|
+ g1b <- -sum(donneesL)
|
||
|
|
+ g2b <- -2*sum((donneesF - a - b*donneesL)*donneesL)
|
||
|
|
+ g3b <- -sum(donneesL^2)
|
||
|
|
+ g4b <- -2*sum((donneesF - a - b*donneesL)*donneesL^2)
|
||
|
|
+
|
||
|
|
+ g1s <- 0
|
||
|
|
+ g2s <- -sum(deltaTemps*donneesL)
|
||
|
|
+ g3s <- 0
|
||
|
|
+ g4s <- -sum(deltaTemps*donneesL*donneesL)
|
||
|
|
+
|
||
|
|
+ d <- cbind(c(g1a, g1b, g1s),
|
||
|
|
+ c(g2a, g2b, g2s),
|
||
|
|
+ c(g3a, g3b, g3s),
|
||
|
|
+ c(g4a, g4b, g4s))/n
|
||
|
|
+ }
|
||
|
|
+ if(modele$nomModele=="Vasicek")
|
||
|
|
+ {
|
||
|
|
+ a <- param[1]
|
||
|
|
+ b <- param[2]
|
||
|
|
+
|
||
|
|
+ g1a <- -n
|
||
|
|
+ g2a <- -2*sum(donneesF - a - b*donneesL)
|
||
|
|
+ g3a <- -sum(donneesL)
|
||
|
|
+ g4a <- -2*sum((donneesF - a - b*donneesL)*donneesL)
|
||
|
|
+
|
||
|
|
+ g1b <- -sum(donneesL)
|
||
|
|
+ g2b <- -2*sum((donneesF - a - b*donneesL)*donneesL)
|
||
|
|
+ g3b <- -sum(donneesL^2)
|
||
|
|
+ g4b <- -2*sum((donneesF - a - b*donneesL)*donneesL^2)
|
||
|
|
+
|
||
|
|
+ g1s <- 0
|
||
|
|
+ g2s <- -deltaTemps*n
|
||
|
|
+ g3s <- 0
|
||
|
|
+ g4s <- -sum(deltaTemps*donneesL)
|
||
|
|
+
|
||
|
|
+ d <- cbind(c(g1a, g1b, g1s),
|
||
|
|
+ c(g2a, g2b, g2s),
|
||
|
|
+ c(g3a, g3b, g3s),
|
||
|
|
+ c(g4a, g4b, g4s))/n
|
||
|
|
+ }
|
||
|
|
+ d
|
||
|
|
+ }
|
||
|
|
>
|
||
|
|
> MMGobjectif<- function(param, modele, W)
|
||
|
|
+ {
|
||
|
|
+ donnees <- modele$donnees
|
||
|
|
+ donneesF <- donnees[-1]
|
||
|
|
+ donneesL <- donnees[-length(donnees)]
|
||
|
|
+ n <- length(donnees)-2
|
||
|
|
+ deltaTemps <- modele$deltaTemps
|
||
|
|
+ a <- param[1]
|
||
|
|
+ b <- param[2]
|
||
|
|
+
|
||
|
|
+ if(modele$nomModele=="CKLS")
|
||
|
|
+ {
|
||
|
|
+ sigma <- param[3]
|
||
|
|
+ gamma <- param[4]
|
||
|
|
+ g1 <- sum(donneesF - a - b * donneesL)
|
||
|
|
+ g2 <- sum((donneesF - a - b * donneesL) ^ 2 - sigma^2 * donneesL ^ (2*gamma) *
|
||
|
|
+ deltaTemps)
|
||
|
|
+ g3 <- sum((donneesF - a - b * donneesL) * donneesL)
|
||
|
|
+ g4 <- sum(((donneesF - a - b * donneesL) ^ 2 - sigma ^ 2 * donneesL ^ (2*gamma) *
|
||
|
|
+ deltaTemps) * donneesL )
|
||
|
|
+ }
|
||
|
|
+
|
||
|
|
+ if(modele$nomModele=="CIR")
|
||
|
|
+ {
|
||
|
|
+ sigma <- param[3]
|
||
|
|
+ g1 <- sum(donneesF - a - b * donneesL)
|
||
|
|
+ g2 <- sum((donneesF - a - b * donneesL) ^ 2 - sigma ^ 2 * donneesL * deltaTemps)
|
||
|
|
+ g3 <- sum((donneesF - a - b * donneesL) * donneesL)
|
||
|
|
+ g4 <- sum(((donneesF - a - b * donneesL) ^ 2 - sigma ^ 2 * donneesL * deltaTemps)*
|
||
|
|
+ donneesL)
|
||
|
|
+ }
|
||
|
|
+
|
||
|
|
+ if(modele$nomModele=="Vasicek")
|
||
|
|
+ {
|
||
|
|
+ sigma <- param[3]
|
||
|
|
+ g1 <- sum(donneesF - a - b * donneesL)
|
||
|
|
+ g2 <- sum((donneesF - a - b * donneesL) ^ 2 - sigma ^ 2 * deltaTemps)
|
||
|
|
+ g3 <- sum((donneesF - a - b * donneesL) * donneesL)
|
||
|
|
+ g4 <- sum(((donneesF - a - b * donneesL) ^ 2 - sigma ^ 2 * deltaTemps) *
|
||
|
|
+ donneesL)
|
||
|
|
+ }
|
||
|
|
+ g <- c(g1,g2,g3,g4)/n
|
||
|
|
+ t(g) %*% W %*% g
|
||
|
|
+ }
|
||
|
|
>
|
||
|
|
> MMGestimation <- function(modele)
|
||
|
|
+ {
|
||
|
|
+ deltaTemps <- modele$deltaTemps
|
||
|
|
+ ## paramètres initiaux
|
||
|
|
+ if(modele$nomModele=="CKLS")
|
||
|
|
+ {
|
||
|
|
+ alpha <- 0.5
|
||
|
|
+ beta <- -0.5
|
||
|
|
+ sigma <- 0.5
|
||
|
|
+ gamma <- 0.5
|
||
|
|
+ a <- alpha * deltaTemps
|
||
|
|
+ b <- beta * deltaTemps + 1
|
||
|
|
+ Initialparam <- c(a,b,sigma,gamma)
|
||
|
|
+ }
|
||
|
|
+ if(modele$nomModele=="CIR" || modele$nomModele=="Vasicek")
|
||
|
|
+ {
|
||
|
|
+ alpha <- 0.5
|
||
|
|
+ beta <- -0.5
|
||
|
|
+ sigma <- 0.5
|
||
|
|
+ a <- alpha * deltaTemps
|
||
|
|
+ b <- beta * deltaTemps + 1
|
||
|
|
+ Initialparam <- c(a,b,sigma)
|
||
|
|
+ }
|
||
|
|
+ ## Première étape avec matrice identité
|
||
|
|
+ W <- diag(4)
|
||
|
|
+ estim <- nlminb(Initialparam,MMGobjectif,gr=NULL,hessian=NULL,modele,W)
|
||
|
|
+ param <- estim$par
|
||
|
|
+ Fval <- estim$objective
|
||
|
|
+ Exitflag <- estim$convergence
|
||
|
|
+ if(modele$nomModele=="CKLS")
|
||
|
|
+ {
|
||
|
|
+ Ralpha <- estim$par[1] / deltaTemps
|
||
|
|
+ Rbeta <- (estim$par[2] - 1) / deltaTemps
|
||
|
|
+ Rsigma2 <- estim$par[3] ^ 2
|
||
|
|
+ Rgamma <- estim$par[4]
|
||
|
|
+ }
|
||
|
|
+ if(modele$nomModele=="CIR")
|
||
|
|
+ {
|
||
|
|
+ Ralpha <- estim$par[1] / deltaTemps
|
||
|
|
+ Rbeta <- (estim$par[2] - 1) / deltaTemps
|
||
|
|
+ Rsigma2 <- estim$par[3] ^ 2
|
||
|
|
+ Rgamma <- 0.5
|
||
|
|
+ }
|
||
|
|
+
|
||
|
|
+ if(modele$nomModele=="Vasicek")
|
||
|
|
+ {
|
||
|
|
+ Ralpha <- estim$par[1] / deltaTemps
|
||
|
|
+ Rbeta <- (estim$par[2] - 1) / deltaTemps
|
||
|
|
+ Rsigma2 <- estim$par[3] ^ 2
|
||
|
|
+ Rgamma <- 0
|
||
|
|
+ }
|
||
|
|
+ ## Seconde étape avec matrice W
|
||
|
|
+ if(modele$Iterations>0)
|
||
|
|
+ {
|
||
|
|
+ for (i in 1:modele$Iterations)
|
||
|
|
+ {
|
||
|
|
+ Initialparam <- param
|
||
|
|
+ W <- MMGpoidsNW(param, modele)
|
||
|
|
+ estim <- nlminb(Initialparam,MMGobjectif,gr=NULL,hessian=NULL,modele,W)
|
||
|
|
+ param <- estim$par
|
||
|
|
+ Fval <- estim$objective
|
||
|
|
+ Exitflag <- estim$convergence
|
||
|
|
+ if(modele$nomModele=="CKLS")
|
||
|
|
+ {
|
||
|
|
+ Ralpha <- estim$par[1] / deltaTemps
|
||
|
|
+ Rbeta <- (estim$par[2] - 1) / deltaTemps
|
||
|
|
+ Rsigma2 <- estim$par[3] ^ 2
|
||
|
|
+ Rgamma <- estim$par[4]
|
||
|
|
+ }
|
||
|
|
+ if(modele$nomModele=="CIR")
|
||
|
|
+ {
|
||
|
|
+ Ralpha <- estim$par[1] / deltaTemps
|
||
|
|
+ Rbeta <- (estim$par[2] - 1) / deltaTemps
|
||
|
|
+ Rsigma2 <- estim$par[3] ^ 2
|
||
|
|
+ Rgamma <- 0.5
|
||
|
|
+ }
|
||
|
|
+
|
||
|
|
+ if(modele$nomModele=="Vasicek")
|
||
|
|
+ {
|
||
|
|
+ Ralpha <- estim$par[1] / deltaTemps
|
||
|
|
+ Rbeta <- (estim$par[2] - 1) / deltaTemps
|
||
|
|
+ Rsigma2 <- estim$par[3] ^ 2
|
||
|
|
+ Rgamma <- 0
|
||
|
|
+ }
|
||
|
|
+ }
|
||
|
|
+ }
|
||
|
|
+
|
||
|
|
+ ## Statistique T
|
||
|
|
+ n <- length(modele$donnees)-1
|
||
|
|
+ d <- MomentsJacobien(param,modele)
|
||
|
|
+ Varparam <- ginv(d %*% W %*% t(d))
|
||
|
|
+ Tstat <- solve(chol(Varparam),param)/sqrt(n)
|
||
|
|
+ Tpvalue <- 1-pt(Tstat,n-length(param))
|
||
|
|
+ list(Tstat=Tstat,Tpvalue=Tpvalue,
|
||
|
|
+ Varparam=Varparam,param = c(Ralpha,Rbeta,Rsigma2,Rgamma), Fval=Fval,
|
||
|
|
+ Exitflag=Exitflag)
|
||
|
|
+
|
||
|
|
+ }
|
||
|
|
>
|
||
|
|
> proc.time()
|
||
|
|
utilisateur système écoulé
|
||
|
|
0.272 0.020 0.286
|