partage/coursdirige-tauxinterets
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity
coursdirige-tauxinterets/gmm.r.Rout
François 2eed4f54ec commit initial du projet
2013-11-02 15:47:28 -04:00

323 lines
10 KiB
Text
Raw Blame History

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
Reference in a new issue View git blame Copy permalink