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