[Gmm-commits] r6 - in pkg/gmm: . R man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Thu Dec 3 04:39:00 CET 2009
Author: chaussep
Date: 2009-12-03 04:39:00 +0100 (Thu, 03 Dec 2009)
New Revision: 6
Added:
pkg/gmm/DESCRIPTION~
pkg/gmm/NAMESPACE~
pkg/gmm/NEWS~
Removed:
pkg/gmm/R/gel_tools.R
pkg/gmm/R/gmm_tools.R
pkg/gmm/man/coef.gel.Rd
pkg/gmm/man/coef.gmm.Rd
pkg/gmm/man/confint.gel.Rd
pkg/gmm/man/confint.gmm.Rd
pkg/gmm/man/fitted.gel.Rd
pkg/gmm/man/fitted.gmm.Rd
pkg/gmm/man/formula.gel.Rd
pkg/gmm/man/formula.gmm.Rd
pkg/gmm/man/get_dat.Rd
pkg/gmm/man/get_lamb.Rd
pkg/gmm/man/plot.gel.Rd
pkg/gmm/man/plot.gmm.Rd
pkg/gmm/man/print.gel.Rd
pkg/gmm/man/print.gmm.Rd
pkg/gmm/man/print.summary.gel.Rd
pkg/gmm/man/print.summary.gmm.Rd
pkg/gmm/man/residuals.gel.Rd
pkg/gmm/man/residuals.gmm.Rd
pkg/gmm/man/summary.gel.Rd
pkg/gmm/man/summary.gmm.Rd
pkg/gmm/man/vcov.gel.Rd
pkg/gmm/man/vcov.gmm.Rd
Log:
Added: pkg/gmm/DESCRIPTION~
===================================================================
--- pkg/gmm/DESCRIPTION~ (rev 0)
+++ pkg/gmm/DESCRIPTION~ 2009-12-03 03:39:00 UTC (rev 6)
@@ -0,0 +1,11 @@
+Package: gmm
+Version: 1.1-1
+Date: 2009-09-03
+Title: Generalized Method of Moments and Generalized Empirical Likelihood
+Author: Pierre Chausse <pierre.chausse at uqam.ca>
+Maintainer: Pierre Chausse <pierre.chausse at uqam.ca>
+Description: It is a complete suite to estimate models based on moment conditions. It includes the two step Generalized method of moments (GMM) of Hansen(1982), the iterated GMM and continuous updated estimator (CUE) of Hansen-Eaton-Yaron(1996) and several methods that belong to the Generalized Empirical Likelihood (GEL) family of estimators, as presented by Smith(1997), Kitamura(1997), Newey-Smith(2004) and Anatolyev(2005).
+Depends: R (>= 2.0.0)
+Suggests: mvtnorm, car, fBasics, MASS, timeDate, timeSeries
+Imports: stats
+License: GPL (>= 2)
Added: pkg/gmm/NAMESPACE~
===================================================================
--- pkg/gmm/NAMESPACE~ (rev 0)
+++ pkg/gmm/NAMESPACE~ 2009-12-03 03:39:00 UTC (rev 6)
@@ -0,0 +1,31 @@
+Import(stats)
+
+export(HAC,gmm,weightsAndrews2,bwAndrews2,summary.gmm,rho,smooth_g,get_dat,bwNeweyWest2,summary.gel,get_lamb,gel,
+ print.gmm,coef.gmm,vcov.gmm,print.summary.gmm, confint.gel, print.gel, print.summary.gel, vcov.gel, coef.gel, fitted.gmm,
+ residuals.gmm, fitted.gel, residuals.gel, plot.gmm, plot.gel,formula.gmm, formula.gel, charStable)
+
+S3method(summary, gmm)
+S3method(summary, gel)
+S3method(print, gmm)
+S3method(print, summary.gmm)
+S3method(coef, gmm)
+S3method(vcov, gmm)
+S3method(confint, gmm)
+S3method(fitted, gmm)
+S3method(residuals, gmm)
+S3method(plot, gmm)
+S3method(formula, gmm)
+S3method(print, gel)
+S3method(print, summary.gel)
+S3method(coef, gel)
+S3method(vcov, gel)
+S3method(confint, gel)
+S3method(fitted, gel)
+S3method(residuals, gel)
+S3method(plot, gel)
+S3method(formula, gel)
+
+
+
+
+
Added: pkg/gmm/NEWS~
===================================================================
--- pkg/gmm/NEWS~ (rev 0)
+++ pkg/gmm/NEWS~ 2009-12-03 03:39:00 UTC (rev 6)
@@ -0,0 +1,45 @@
+Changes in version 1.1-0
+
+
+This is a major upgrade of the package. It follows great suggestions from two anonymous reviewers from JSS.
+The package as been modified so that it is now very close to lm and glm. The following applies both to the functions
+gmm and gel.
+
+ o The name of the vector of parameters is now "coefficients" instead of "par"
+ o The following methods are now available (see lm): fitted, residuals, vcov, coef, confint
+ o There are now print methods for gmm, gel and summary.gel and summary.gmm
+ o These modifications allows to use linear.hypothesis from the car package so the function lintest is no longer needed and as been removed
+ o The following are now available from gmm and gel objects when g is a formula: residuals, fitted.values, model.frame, terms, model, the response and model matrix
+ o Because the presence of the confint method, the option "interval" as been removed from the summary methods
+ o A new plot method is available for both gmm and gel objects. It is a beta version. Comments and suggestions are welcome.
+ o If there is only one instrument it can be provided as a vector. It does not need to be a matrix anymore.
+ o The package no longer depends on mvtnorm. It is a suggested package as it is only required for examples.
+ o The packages car and fBasics (and therefore MASS, timeDate and timeSeries) are now suggested for examples in the vignette.
+ o The new function charStable has been added. It computes the characteristic function of a stable distribution. An example is shown in the vignette
+ o There was a bug when trying to estimate a model by ETEL with gel and numerical computation of lambda. It is fixed. Thanks to Márcio Laurini.
+ o The vignette as beed rewritten.
+
+Changes in Version 1.0-7
+
+ o Modified some functions to remove dependencies on tseries and sandwich packages
+ o Convert de Finance Data to data frame format
+
+
+Changes in Version 1.0-6
+
+ o Some bugs fixed. Thanks to Justinas Brazys
+
+Changes in Version 1.0-4
+
+ o documentation enhancements
+
+ o Added finance data for applied examples
+
+
+Changes in Version 1.0-3
+
+ o Some bugs fixed
+
+Changes in Version 1.0-2
+
+ o Added a new example for better understanding.
Deleted: pkg/gmm/R/gel_tools.R
===================================================================
--- pkg/gmm/R/gel_tools.R 2009-12-03 03:14:37 UTC (rev 5)
+++ pkg/gmm/R/gel_tools.R 2009-12-03 03:39:00 UTC (rev 6)
@@ -1,287 +0,0 @@
-# This program is free software; you can redistribute it and/or modify
-# it under the terms of the GNU General Public License as published by
-# the Free Software Foundation; either version 2 of the License, or
-# (at your option) any later version.
-#
-# This program is distributed in the hope that it will be useful,
-# but WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-# GNU General Public License for more details.
-#
-# A copy of the GNU General Public License is available at
-# http://www.r-project.org/Licenses/
-
-
-smooth_g <- function (x, bw = bwAndrews2, prewhite = 1, ar.method = "ols",weights=weightsAndrews2,
- kernel=c("Bartlett","Parzen","Truncated","Tukey-Hanning"), approx = c("AR(1)","ARMA(1,1)"),
- tol = 1e-7)
- {
- kernel <- match.arg(kernel)
- approx <- match.arg(approx)
-
- n <- nrow(x)
- if (is.function(weights))
- {
- w <- weights(x, bw = bw, kernel = kernel,
- prewhite = prewhite, ar.method = ar.method, tol = tol,
- verbose = FALSE, approx = approx)
- }
- else
- w <- weights
-
-
- rt <- length(w)
- if (rt >= 2)
- {
- w <- c(w[rt:2],w)
- w <- w / sum(w)
- rt <- rt-1
- sgt <- function(t) crossprod(x[(t-rt):(t+rt),],w)
- x[(rt+1):(n-rt),] <- t(sapply((rt+1):(n-rt),sgt))
- sx <- list("smoothx"=x,"kern_weights"=w)
- return(sx)
- }
- else
- sx <- list("smoothx"=x,"kern_weights"=1)
- return(sx)
- }
-
-bwNeweyWest2 <- function (x, kernel = c("Bartlett", "Parzen",
- "Quadratic Spectral", "Truncated", "Tukey-Hanning"),
- prewhite = 1, ar.method = "ols",...)
-{
- kernel <- match.arg(kernel)
- if (kernel %in% c("Truncated", "Tukey-Hanning"))
- stop(paste("Automatic bandwidth selection only available for ",
- dQuote("Bartlett"), ", ", dQuote("Parzen"), " and ",
- dQuote("Quadratic Spectral"), " kernel. Use ", sQuote("bwAndrews2"),
- " instead.", sep = ""))
- prewhite <- as.integer(prewhite)
- n <- nrow(x)
- k <- ncol(x)
- weights <- rep(1, k)
- if (length(weights) < 2)
- weights <- 1
- mrate <- switch(kernel, Bartlett = 2/9, Parzen = 4/25, "Quadratic Spectral" = 2/25)
- m <- floor(ifelse(prewhite > 0, 3, 4) * (n/100)^mrate)
- if (prewhite > 0) {
- x <- as.matrix(na.omit(ar(x, order.max = prewhite,
- demean = FALSE, aic = FALSE, method = ar.method)$resid))
- n <- n - prewhite
- }
- hw <- x %*% weights
- sigmaj <- function(j) sum(hw[1:(n - j)] * hw[(j + 1):n])/n
- sigma <- sapply(0:m, sigmaj)
- s0 <- sigma[1] + 2 * sum(sigma[-1])
- s1 <- 2 * sum(1:m * sigma[-1])
- s2 <- 2 * sum((1:m)^2 * sigma[-1])
- qrate <- 1/(2 * ifelse(kernel == "Bartlett", 1, 2) + 1)
- rval <- switch(kernel, Bartlett = {
- 1.1447 * ((s1/s0)^2)^qrate
- }, Parzen = {
- 2.6614 * ((s2/s0)^2)^qrate
- }, "Quadratic Spectral" = {
- 1.3221 * ((s2/s0)^2)^qrate
- })
- rval <- rval * (n + prewhite)^qrate
- return(rval)
-}
-
-confint.gel <- function(object, parm, level=0.95, lambda=FALSE, ...)
- {
- z <- object
- n <- nrow(z$gt)
-
- se_par <- sqrt(diag(z$vcov_par))
- par <- z$coefficients
- tval <- par/se_par
-
- se_parl <- sqrt(diag(z$vcov_lambda))
- lamb <- z$lambda
-
- zs <- qnorm((1-level)/2,lower.tail=FALSE)
- ch <- zs*se_par
-
- if(!lambda)
- {
- ans <- cbind(par-ch,par+ch)
- dimnames(ans) <- list(names(par),c((1-level)/2,0.5+level/2))
- }
- if(lambda)
- {
- chl <- zs*se_parl
- ans <- cbind(lamb-chl,lamb+chl)
- dimnames(ans) <- list(names(lamb),c((1-level)/2,0.5+level/2))
- }
- if(!missing(parm))
- ans <- ans[parm,]
- ans
- }
-
-coef.gel <- function(object, lambda=FALSE, ...)
- {
- if(!lambda)
- object$coefficients
- else
- object$lambda
- }
-
-vcov.gel <- function(object, lambda=FALSE, ...)
- {
- if(!lambda)
- object$vcov_par
- else
- object$vcov_lambda
- }
-
-print.gel <- function(x, digits=5, ...)
- {
- cat("Type de GEL: ", x$type,"\n\n")
- cat("Coefficients:\n")
- print.default(format(coef(x), digits=digits),
- print.gap = 2, quote = FALSE)
- cat("\n")
- cat("Lambdas:\n")
- print.default(format(coef(x,lambda=TRUE), digits=digits),
- print.gap = 2, quote = FALSE)
- invisible(x)
- }
-
-print.summary.gel <- function(x, digits = 5, ...)
- {
- cat("\nCall:\n")
- cat(paste(deparse(x$call), sep="\n", collapse = "\n"), "\n\n", sep="")
- cat("\nType of GEL: ", x$type,"\n\n")
- cat("Kernel: ", x$kernel,"\n\n")
- cat("Coefficients:\n")
- print.default(format(x$coefficients, digits=digits),
- print.gap = 2, quote = FALSE)
-
- cat("\nLambdas:\n")
- print.default(format(x$lambda, digits=digits),
- print.gap = 2, quote = FALSE)
-
- cat("\nTests of overidentifying restrictions:\n")
- print.default(format(x$test, digits=digits),
- print.gap = 2, quote = FALSE)
- cat("\nConvergence code for the coefficients: ",x$conv_par,"\n")
- cat("\nConvergence code for the lambdas: ",x$conv_lambda,"\n")
-
- invisible(x)
- }
-
-
-summary.gel <- function(object, ...)
- {
- z <- object
- n <- nrow(z$gt)
- khat <- crossprod(z$gt)/n
- gbar <- colMeans(z$gt)
-
- se_par <- sqrt(diag(z$vcov_par))
- par <- z$coefficients
- tval <- par/se_par
-
- se_parl <- sqrt(diag(z$vcov_lambda))
- lamb <- z$lambda
- tvall <- lamb/se_parl
-
- LR_test <- 2*z$objective*n
- LM_test <- n*crossprod(z$lambda,crossprod(khat,z$lambda))
- J_test <- n*crossprod(gbar,solve(khat,gbar))
- test <- c(LR_test,LM_test,J_test)
- vptest <- pchisq(test,(ncol(z$gt)-length(z$par)),lower.tail=FALSE)
- ans <- list(type=z$type,call=z$call)
- names(ans$type) <-"Type of GEL"
-
- ans$coefficients <- round(cbind(par,se_par, tval, 2 * pnorm(abs(tval), lower.tail = FALSE)),5)
- ans$lambda <- round(cbind(lamb,se_parl, tvall, 2 * pnorm(abs(tvall), lower.tail = FALSE)),5)
-
- dimnames(ans$coefficients) <- list(names(z$coefficients),
- c("Estimate", "Std. Error", "t value", "Pr(>|t|)"))
- dimnames(ans$lambda) <- list(names(z$lambda),
- c("Estimate", "Std. Error", "t value", "Pr(>|t|)"))
-
- ans$test <- cbind(test,vptest)
- dimnames(ans$test) <- list(c("LR test","LM test","J test"),c("statistics","p-value"))
-
- if (z$type == "EL")
- ans$badrho <- z$badrho
- if (!is.null(z$weights))
- {
- ans$weights <- z$weights
- }
- ans$conv_par <- z$conv_par
- ans$conv_pt <- z$conv_pt
- ans$conv_moment <- cbind(z$conv_moment)
- ans$conv_lambda <- z$conv_lambda
- names(ans$conv_par) <- "Convergence_code_theta"
- names(ans$conv_pt) <- "Sum_of_pt"
- names(ans$conv_lambda) <- "Convergence_code_for_lambda"
- dimnames(ans$conv_moment) <- list(names(z$gt),"Sample_moment_with_pt")
- class(ans) <- "summary.gel"
- ans
-}
-
-get_dat <- function (formula,h)
-{
- cl <- match.call()
- mf <- match.call(expand.dots = FALSE)
- m <- match(c("formula", "data"), names(mf), 0L)
- mf <- mf[c(1L, m)]
- mf$drop.unused.levels <- TRUE
- mf[[1L]] <- as.name("model.frame")
- mf <- eval(mf, parent.frame())
- mt <- attr(mf, "terms")
- if (!is.matrix(h))
- h <- cbind(rep(1,length(h)),h)
- else
- h <- cbind(rep(1,nrow(h)),h)
- colnames(h) <- c("(Intercept)",paste("h",1:(ncol(h)-1),sep=""))
- y <- as.matrix(model.response(mf, "numeric"))
- x <- as.matrix(model.matrix(mt, mf, NULL))
- if (attr(mt,"intercept")==0)
- {
- h <- as.matrix(h[,2:ncol(h)])
- }
- ny <- ncol(y)
- k <- ncol(x)
- nh <- ncol(h)
- if (nrow(y) != nrow(x) | nrow(x) != nrow(h) | nrow(y)!=nrow(h))
- stop("The number of observations of X, Y and H must be the same")
- if (nh<k)
- stop("The number of moment conditions must be at least equal to the number of coefficients to estimate")
- if (is.null(colnames(y)))
- {
- if (ny>1)
- colnames(y) <- paste("y",1:ncol(y),sep="")
- if (ny == 1)
- colnames(y) <- "y"
- }
- x <- cbind(y,x,h)
- return(list(x=x,nh=nh,ny=ny,k=k,mf=mf,mt=mt,cl=cl))
-}
-
-
-residuals.gel <- function(object,...)
- {
- if(is.null(object$model))
- stop("The residuals method is valid only for g=formula")
- object$residuals
- }
-
-fitted.gel <- function(object,...)
- {
- if(is.null(object$model))
- stop("The residuals method is valid only for g=formula")
- object$fitted.value
- }
-
-formula.gel <- function(x, ...)
-{
- if(is.null(x$terms))
- stop("The gel object was not created by a formula")
- else
- formula(x$terms)
-}
-
Deleted: pkg/gmm/R/gmm_tools.R
===================================================================
--- pkg/gmm/R/gmm_tools.R 2009-12-03 03:14:37 UTC (rev 5)
+++ pkg/gmm/R/gmm_tools.R 2009-12-03 03:39:00 UTC (rev 6)
@@ -1,324 +0,0 @@
-# This program is free software; you can redistribute it and/or modify
-# it under the terms of the GNU General Public License as published by
-# the Free Software Foundation; either version 2 of the License, or
-# (at your option) any later version.
-#
-# This program is distributed in the hope that it will be useful,
-# but WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-# GNU General Public License for more details.
-#
-# A copy of the GNU General Public License is available at
-# http://www.r-project.org/Licenses/
-
-
-HAC <- function (x, weights = weightsAndrews2, bw = bwAndrews2, prewhite = FALSE, ar.method = "ols", kernel=c("Quadratic Spectral", "Truncated", "Bartlett", "Parzen", "Tukey-Hanning"), approx="AR(1)",tol = 1e-7)
-{
- n.orig <- n <- nrow(x)
- k <- ncol(x)
- kernel=match.arg(kernel)
- if(prewhite > 0)
- {
- var.fit <- ar(x, order.max = prewhite, demean = FALSE, aic = FALSE, method = ar.method)
- if(k > 1) D <- solve(diag(ncol(x)) - apply(var.fit$ar, 2:3, sum))
- else D <- as.matrix(1/(1 - sum(var.fit$ar)))
- x <- as.matrix(na.omit(var.fit$resid))
- n <- n - prewhite
- }
- weights <- weights(x, ar.method = ar.method,kernel=kernel,bw=bw, approx = approx, prewhite = 1, tol = tol)
- if (length(weights) > n)
- {
- warning("more weights than observations, only first n used")
- weights <- weights[1:n]
- }
- utu <- 0.5 * crossprod(x) * weights[1]
- wsum <- n * weights[1]/2
- w2sum <- n * weights[1]^2/2
- if (length(weights) > 1) {
- for (ii in 2:length(weights)) {
- utu <- utu + weights[ii] * crossprod(x[1:(n -
- ii + 1), , drop = FALSE], x[ii:n, , drop = FALSE])
- wsum <- wsum + (n - ii + 1) * weights[ii]
- w2sum <- w2sum + (n - ii + 1) * weights[ii]^2
- }
- }
- utu <- utu + t(utu)
-
- if(prewhite > 0) {
- utu <- crossprod(t(D), utu) %*% t(D)
- }
- wsum <- 2 * wsum
- w2sum <- 2 * w2sum
- bc <- n^2/(n^2 - wsum)
- df <- n^2/w2sum
- rval <- utu/n.orig
-
- return(rval)
-}
-
-weightsAndrews2 <- function (x, bw = bwAndrews2, kernel = c("Quadratic Spectral",
- "Truncated", "Bartlett", "Parzen", "Tukey-Hanning"), approx = c("AR(1)",
- "ARMA(1,1)"), prewhite = 1, ar.method = "ols", tol = 1e-7, verbose = FALSE)
-{
- kernel <- match.arg(kernel)
- approx=match.arg(approx)
-
- if (is.function(bw))
- bw <- bw(x, kernel = kernel, prewhite = prewhite, ar.method = ar.method, approx=approx)
- n <- NROW(x)
- weights <- kweights2(0:(n - 1)/bw, kernel = kernel)
- weights <- weights[1:max(which(abs(weights) > tol))]
- return(weights)
-}
-
-
-bwAndrews2 <- function (x, kernel = c("Quadratic Spectral",
- "Truncated", "Bartlett", "Parzen", "Tukey-Hanning"), approx = c("AR(1)",
- "ARMA(1,1)"), prewhite = 1, ar.method = "ols")
-{
- kernel <- match.arg(kernel)
- approx <- match.arg(approx)
- n <- nrow(x)
- k <- ncol(x)
-
- if (approx == "AR(1)") {
- fitAR1 <- function(x) {
- rval <- ar(x, order.max = 1, aic = FALSE, method = "ols")
- rval <- c(rval$ar, sqrt(rval$var.pred))
- names(rval) <- c("rho", "sigma")
- return(rval)
- }
- ar.coef <- apply(x, 2, fitAR1)
- denum <- sum((ar.coef["sigma", ]/(1 - ar.coef["rho",
- ]))^4)
- alpha2 <- sum(4 * ar.coef["rho", ]^2 * ar.coef["sigma",
- ]^4/(1 - ar.coef["rho", ])^8)/denum
- alpha1 <- sum(4 * ar.coef["rho", ]^2 * ar.coef["sigma",
- ]^4/((1 - ar.coef["rho", ])^6 * (1 + ar.coef["rho",
- ])^2))/denum
- }
- else {
- fitARMA11 <- function(x) {
- rval <- arima(x, order = c(1, 0, 1), include.mean = FALSE)
- rval <- c(rval$coef, sqrt(rval$sigma2))
- names(rval) <- c("rho", "psi", "sigma")
- return(rval)
- }
- arma.coef <- apply(x, 2, fitARMA11)
- denum <- sum(((1 + arma.coef["psi", ]) * arma.coef["sigma",
- ]/(1 - arma.coef["rho", ]))^4)
- alpha2 <- sum(4 * ((1 + arma.coef["rho", ] *
- arma.coef["psi", ]) * (arma.coef["rho", ] + arma.coef["psi",
- ]))^2 * arma.coef["sigma", ]^4/(1 - arma.coef["rho",
- ])^8)/denum
- alpha1 <- sum(4 * ((1 + arma.coef["rho", ] *
- arma.coef["psi", ]) * (arma.coef["rho", ] + arma.coef["psi",
- ]))^2 * arma.coef["sigma", ]^4/((1 - arma.coef["rho",
- ])^6 * (1 + arma.coef["rho", ])^2))/denum
- }
- rval <- switch(kernel, Truncated = {
- 0.6611 * (n * alpha2)^(1/5)
- }, Bartlett = {
- 1.1447 * (n * alpha1)^(1/3)
- }, Parzen = {
- 2.6614 * (n * alpha2)^(1/5)
- }, "Tukey-Hanning" = {
- 1.7462 * (n * alpha2)^(1/5)
- }, "Quadratic Spectral" = {
- 1.3221 * (n * alpha2)^(1/5)
- })
- return(rval)
-}
-
-summary.gmm <- function(object, ...)
- {
- z <- object
- se <- sqrt(diag(z$vcov))
- par <- z$coefficients
- tval <- par/se
- j <- z$objective*z$n
- ans <- list(met=z$met,kernel=z$kernel,algo=z$algo,call=z$call)
- names(ans$met) <- "GMM method"
- names(ans$kernel) <- "kernel for cov matrix"
-
- ans$coefficients <- round(cbind(par,se, tval, 2 * pnorm(abs(tval), lower.tail = FALSE)),5)
-
- dimnames(ans$coefficients) <- list(names(z$coefficients),
- c("Estimate", "Std. Error", "t value", "Pr(>|t|)"))
-
- ans$J_test <- noquote(paste("Test-J degrees of freedom is ",z$df,sep=""))
- ans$j <- noquote(cbind(j,ifelse(z$df>0,pchisq(j,z$df,lower.tail = FALSE),"*******")))
- dimnames(ans$j) <- list("Test E(g)=0: ",c("J-test","Pz(>j)"))
- class(ans) <- "summary.gmm"
- ans
- }
-
-confint.gmm <- function(object, parm, level=0.95, ...)
- {
- z <- object
- se <- sqrt(diag(z$vcov))
- par <- z$coefficients
-
- zs <- qnorm((1-level)/2,lower.tail=FALSE)
- ch <- zs*se
- ans <- cbind(par-ch,par+ch)
- dimnames(ans) <- list(names(par),c((1-level)/2,0.5+level/2))
- if(!missing(parm))
- ans <- ans[parm,]
- ans
- }
-
-
-kweights2 <- function(x, kernel = c("Truncated", "Bartlett", "Parzen",
- "Tukey-Hanning", "Quadratic Spectral"), normalize = FALSE)
-{
- kernel <- match.arg(kernel)
- if(normalize) {
- ca <- switch(kernel,
- "Truncated" = 2,
- "Bartlett" = 2/3,
- "Parzen" = .539285,
- "Tukey-Hanning" = 3/4,
- "Quadratic Spectral" = 1)
- } else ca <- 1
-
- switch(kernel,
- "Truncated" = { ifelse(ca * x > 1, 0, 1) },
- "Bartlett" = { ifelse(ca * x > 1, 0, 1 - abs(ca * x)) },
- "Parzen" = {
- ifelse(ca * x > 1, 0, ifelse(ca * x < 0.5,
- 1 - 6 * (ca * x)^2 + 6 * abs(ca * x)^3, 2 * (1 - abs(ca * x))^3))
- },
- "Tukey-Hanning" = {
- ifelse(ca * x > 1, 0, (1 + cos(pi * ca * x))/2)
- },
- "Quadratic Spectral" = {
- y <- 6 * pi * x/5
- ifelse(x < 1e-4, 1, 3 * (1/y)^2 * (sin(y)/y - cos(y)))
- })
-}
-
-
-residuals.gmm <- function(object,...)
- {
- if(is.null(object$model))
- stop("The residuals method is valid only for g=formula")
- object$residuals
- }
-
-fitted.gmm <- function(object,...)
- {
- if(is.null(object$model))
- stop("The residuals method is valid only for g=formula")
- object$fitted.value
- }
-
-print.gmm <- function(x, digits=5, ...)
- {
- cat("Method\n", x$met,"\n\n")
- cat("Objective function value: ",x$objective,"\n\n")
- print.default(format(coef(x), digits=digits),
- print.gap = 2, quote = FALSE)
- cat("\n")
- invisible(x)
- }
-
-coef.gmm <- function(object,...) object$coefficients
-
-vcov.gmm <- function(object,...) object$vcov
-
-
-print.summary.gmm <- function(x, digits = 5, ...)
- {
- cat("\nCall:\n")
- cat(paste(deparse(x$call), sep="\n", collapse = "\n"), "\n\n", sep="")
- cat("\nMethod: ", x$met,"\n\n")
- cat("Kernel: ", x$kernel,"\n\n")
- cat("Coefficients:\n")
- print.default(format(x$coefficients, digits=digits),
- print.gap = 2, quote = FALSE)
-
- cat("\nJ-test:\n")
- print.default(format(x$j, digits=digits),
- print.gap = 2, quote = FALSE)
- cat("\n")
- invisible(x)
- }
-
-charStable <- function(theta,tau,pm=0)
- {
- # pm is the type parametrization as described by Nolan(2009)
- # It takes the value 0 or 1
-
- # const can fixe parameters. It is NULL for no constraint or
- # a matrix in which case the constraint is theta[const[,1]]=const[,2]
-
- a <- theta[1]
- b <- theta[2]
- g <- theta[3]
- d <- theta[4]
- if(pm == 0)
- {
- if(a == 1)
- {
- if(g == 0)
- {
- the_car <- exp(complex(ima=d*tau))
- }
- else
- {
- re_p <- -g*abs(tau)
- im_p <- d*tau
- im_p[tau!=0] <- im_p[tau!=0] + re_p[tau!=0]*2/pi*b*sign(tau[tau!=0])*log(g*abs(tau[tau!=0]))
- the_car <- exp(complex(re=re_p,ima=im_p))
- }
- }
- else
- {
- if(g == 0)
- {
- the_car <- exp(complex(ima=d*tau))
- }
- else
- {
- phi <- tan(pi*a/2)
- re_p <- -g^a*abs(tau)^a
- im_p <- d*tau*1i
- im_p[tau!=0] <- im_p[tau!=0] + re_p*( b*phi*sign(tau[tau!=0])*(abs(g*tau[tau!=0])^(1-a)-1) )
- the_car <- exp(complex(re=re_p,ima=im_p))
- }
- }
- }
-
- if(pm == 1)
- {
- if(a == 1)
- {
- re_p <- -g*abs(tau)
- im_p <- d*tau
- im_p[tau!=0] <- im_p[tau!=0]+re_p*(b*2/pi*sign(tau[tau!=0])*log(abs(tau[tau!=0])))
- the_car <- exp(complex(re=re_p,ima=im_p))
- }
- else
- {
- phi <- tan(pi*a/2)
- re_p <- -g^a*abs(tau)^a
- im_p <- re_p*(-phi*b*sign(tau))+d*tau
- the_car <- exp(complex(re=re_p,ima=im_p))
- }
- }
- return(the_car)
- }
-
-
-
-
-
-
-
-
-
-
-
-
-
Deleted: pkg/gmm/man/coef.gel.Rd
===================================================================
--- pkg/gmm/man/coef.gel.Rd 2009-12-03 03:14:37 UTC (rev 5)
+++ pkg/gmm/man/coef.gel.Rd 2009-12-03 03:39:00 UTC (rev 6)
@@ -1,41 +0,0 @@
-\name{coef.gel}
-\alias{coef.gel}
-\title{Coefficient of GEL}
-\description{
- It extracts the coefficients from \code{gel} objects.
-}
-\usage{
-\method{coef}{gel}(object, lambda=FALSE, ...)
-}
-\arguments{
- \item{object}{An object of class \code{gel} returned by the function \code{\link{gel}}}
-\item{lambda}{If set to TRUE, the lagrange multipliers are extracted instead of the vecteur of coefficients}
-\item{...}{Other arguments when \code{coef} is applied to an other classe object}
-}
-
-\value{
-Vector of coefficients
-}
-
-
-\examples{
-n = 500
-phi<-c(.2,.7)
-thet <- 0
-sd <- .2
-x <- matrix(arima.sim(n=n,list(order=c(2,0,1),ar=phi,ma=thet,sd=sd)),ncol=1)
-y <- x[7:n]
-ym1 <- x[6:(n-1)]
-ym2 <- x[5:(n-2)]
-
-H <- cbind(x[4:(n-3)],x[3:(n-4)],x[2:(n-5)],x[1:(n-6)])
-g <- y~ym1+ym2
-x <- H
-t0 <- c(0,.5,.5)
-
-res <- gel(g,x,t0)
-
-coef(res)
-coef(res,lambda=TRUE)
-}
-
Deleted: pkg/gmm/man/coef.gmm.Rd
===================================================================
--- pkg/gmm/man/coef.gmm.Rd 2009-12-03 03:14:37 UTC (rev 5)
+++ pkg/gmm/man/coef.gmm.Rd 2009-12-03 03:39:00 UTC (rev 6)
@@ -1,37 +0,0 @@
-\name{coef.gmm}
-\alias{coef.gmm}
-\title{Coefficients of GMM}
-\description{
- It extracts the coefficients from \code{gmm} objects.
-}
-\usage{
-\method{coef}{gmm}(object, ...)
-}
-\arguments{
- \item{object}{An object of class gmm returned by the function \code{\link{gmm}}}
-\item{...}{Other arguments when \code{coef} is applied to another classe object}
-}
-
-\value{
-Vector of coefficients
-}
-
-
-\examples{
-n = 500
-phi<-c(.2,.7)
-thet <- 0
-sd <- .2
-x <- matrix(arima.sim(n=n,list(order=c(2,0,1),ar=phi,ma=thet,sd=sd)),ncol=1)
-y <- x[7:n]
-ym1 <- x[6:(n-1)]
-ym2 <- x[5:(n-2)]
-
-H <- cbind(x[4:(n-3)],x[3:(n-4)],x[2:(n-5)],x[1:(n-6)])
-g <- y~ym1+ym2
-x <- H
-
-res <- gmm(g,x)
-coef(res)
-}
-
Deleted: pkg/gmm/man/confint.gel.Rd
===================================================================
--- pkg/gmm/man/confint.gel.Rd 2009-12-03 03:14:37 UTC (rev 5)
+++ pkg/gmm/man/confint.gel.Rd 2009-12-03 03:39:00 UTC (rev 6)
@@ -1,58 +0,0 @@
-\name{confint.gel}
-\alias{confint.gel}
-\title{Confidence intervals for GEL}
-\description{
- It produces confidence intervals for the coefficients and the lambdas from \code{gel} estimation.
-}
-\usage{
-\method{confint}{gel}(object, parm, level=0.95, lambda=FALSE, ...)
-}
-\arguments{
- \item{object}{An object of class \code{gel} returned by the function \code{\link{gel}}}
-\item{parm}{A specification of which parameters are to be given confidence intervals, either a vector of numbers or a vector
- of names. If missing, all parameters are considered.}
-\item{level}{The confidence level}
-\item{lambda}{If set to TRUE, the confidence intervals for the Lagrange multipliers are produced.}
-\item{...}{Other arguments when \code{confint} is applied to another classe object}
-}
-
-\value{
-It returns a matrix with the first column being the lower bound and the second the upper bound.}
-
-
-\references{
- Hansen, L.P. (1982),
- Large Sample Properties of Generalized Method of Moments Estimators.
- \emph{Econometrica}, \bold{50},
- 1029-1054,
-
- Hansen, L.P. and Heaton, J. and Yaron, A.(1996),
- Finit-Sample Properties of Some Alternative GMM Estimators.
- \emph{Journal of Business and Economic Statistics}, \bold{14}
- 262-280.
-}
-
-
-\examples{
-n = 500
-phi<-c(.2,.7)
-thet <- 0
-sd <- .2
-x <- matrix(arima.sim(n=n,list(order=c(2,0,1),ar=phi,ma=thet,sd=sd)),ncol=1)
-y <- x[7:n]
-ym1 <- x[6:(n-1)]
-ym2 <- x[5:(n-2)]
-
-H <- cbind(x[4:(n-3)],x[3:(n-4)],x[2:(n-5)],x[1:(n-6)])
-g <- y~ym1+ym2
-x <- H
-t0 <- c(0,.5,.5)
-
-res <- gel(g,x,t0)
-
-confint(res)
-confint(res,level=0.90)
-confint(res,lambda=TRUE)
-
-}
-
Deleted: pkg/gmm/man/confint.gmm.Rd
===================================================================
--- pkg/gmm/man/confint.gmm.Rd 2009-12-03 03:14:37 UTC (rev 5)
+++ pkg/gmm/man/confint.gmm.Rd 2009-12-03 03:39:00 UTC (rev 6)
@@ -1,54 +0,0 @@
-\name{confint.gmm}
-\alias{confint.gmm}
-\title{Confidence intervals for gmm}
-\description{
- It produces confidence intervals for the coefficients from \code{gmm} estimation.}
-\usage{
-\method{confint}{gmm}(object, parm, level=0.95, ...)
-}
-\arguments{
- \item{object}{An object of class \code{gmm} returned by the function \code{\link{gmm}}}
-\item{level}{The confidence level}
-\item{parm}{a specification of which parameters are to be given confidence intervals, either a vector of numbers or a vector
- of names. If missing, all parameters are considered.}
-\item{...}{Other arguments when \code{confint} is applied to an other classe object}
-}
-
-\value{
-It returns a matrix with the first column being the lower bound and the second the upper bound.}
-
-
-\references{
- Hansen, L.P. (1982),
- Large Sample Properties of Generalized Method of Moments Estimators.
- \emph{Econometrica}, \bold{50},
- 1029-1054,
-
- Hansen, L.P. and Heaton, J. and Yaron, A.(1996),
- Finit-Sample Properties of Some Alternative GMM Estimators.
- \emph{Journal of Business and Economic Statistics}, \bold{14}
- 262-280.
-}
-
-
-\examples{
-n = 500
-phi<-c(.2,.7)
-thet <- 0
-sd <- .2
-x <- matrix(arima.sim(n=n,list(order=c(2,0,1),ar=phi,ma=thet,sd=sd)),ncol=1)
-y <- x[7:n]
-ym1 <- x[6:(n-1)]
-ym2 <- x[5:(n-2)]
-
-H <- cbind(x[4:(n-3)],x[3:(n-4)],x[2:(n-5)],x[1:(n-6)])
-g <- y~ym1+ym2
-x <- H
-
-res <- gmm(g,x)
-
-confint(res)
-confint(res,level=0.90)
-
-}
-
Deleted: pkg/gmm/man/fitted.gel.Rd
===================================================================
--- pkg/gmm/man/fitted.gel.Rd 2009-12-03 03:14:37 UTC (rev 5)
+++ pkg/gmm/man/fitted.gel.Rd 2009-12-03 03:39:00 UTC (rev 6)
@@ -1,41 +0,0 @@
-\name{fitted.gel}
-\alias{fitted.gel}
-\title{Fitted values of GEL}
-\description{
- Method to extract the fitted values of the model estimated by \code{\link{gel}}.
-}
-\usage{
-\method{fitted}{gel}(object, ...)
-}
-\arguments{
- \item{object}{An object of class \code{gel} returned by the function \code{\link{gel}}}
-\item{...}{Other arguments when \code{fitted} is applied to an other classe object}
-}
-
-\value{
-It returns a matrix of the estimated mean \eqn{\hat{y}} in \code{g=y~x} as it is done by \code{fitted.lm}.
-}
-
-\examples{
-
-# GEL can deal with endogeneity problems
-
-n = 200
-phi<-c(.2,.7)
-thet <- 0.2
-sd <- .2
-set.seed(123)
-x <- matrix(arima.sim(n=n,list(order=c(2,0,1),ar=phi,ma=thet,sd=sd)),ncol=1)
-
-y <- x[7:n]
-ym1 <- x[6:(n-1)]
-ym2 <- x[5:(n-2)]
-H <- cbind(x[4:(n-3)],x[3:(n-4)],x[2:(n-5)],x[1:(n-6)])
-g <- y~ym1+ym2
-x <- H
-
-res <- gel(g,x,c(0,.3,.6))
-plot(y, main="Fitted ARMA with GEL")
-lines(fitted(res),col=2)
-}
-
Deleted: pkg/gmm/man/fitted.gmm.Rd
===================================================================
--- pkg/gmm/man/fitted.gmm.Rd 2009-12-03 03:14:37 UTC (rev 5)
+++ pkg/gmm/man/fitted.gmm.Rd 2009-12-03 03:39:00 UTC (rev 6)
@@ -1,36 +0,0 @@
-\name{fitted.gmm}
-\alias{fitted.gmm}
-\title{Fitted values of GMM}
-\description{
- Method to extract the fitted values of the model estimated by \code{\link{gmm}}.
-}
-\usage{
-\method{fitted}{gmm}(object, ...)
-}
-\arguments{
- \item{object}{An object of class \code{gmm} returned by the function \code{\link{gmm}}}
-\item{...}{Other arguments when \code{fitted} is applied to an other classe object}
-}
-
-\value{
-It returns a matrix of the estimated mean \eqn{\hat{y}} in \code{g=y~x} as it is done by \code{fitted.lm}.
-}
-
-\examples{
-
-# GMM is like GLS for linear models without endogeneity problems
-
-set.seed(345)
-n = 200
-phi<-c(.2,.7)
-thet <- 0
-sd <- .2
-x <- matrix(arima.sim(n=n,list(order=c(2,0,1),ar=phi,ma=thet,sd=sd)),ncol=1)
-y <- 10+5*rnorm(n) + x
-
-res <- gmm(y~x,x)
-plot(x,y, main="Fitted model with GMM")
-lines(x,fitted(res),col=2,)
-legend("topright",c("Y","Yhat"),col=1:2,lty=c(1,1))
-}
-
Deleted: pkg/gmm/man/formula.gel.Rd
===================================================================
--- pkg/gmm/man/formula.gel.Rd 2009-12-03 03:14:37 UTC (rev 5)
+++ pkg/gmm/man/formula.gel.Rd 2009-12-03 03:39:00 UTC (rev 6)
@@ -1,31 +0,0 @@
-\name{formula.gel}
-\alias{formula.gel}
-\title{Formula method for gel objects}
-\description{
- Method to extract the formula from \code{gel} objects produced by \code{\link{gel}}.
-}
-\usage{
-\method{formula}{gel}(x, ...)
-}
-\arguments{
- \item{x}{An object of class \code{gel} returned by the function \code{\link{gel}}}
-\item{...}{Other arguments to pass to other methods}
-}
-\examples{
-n = 200
-phi<-c(.2,.7)
-thet <- 0.2
-sd <- .2
-set.seed(123)
-x <- matrix(arima.sim(n=n,list(order=c(2,0,1),ar=phi,ma=thet,sd=sd)),ncol=1)
-
-y <- x[7:n]
-ym1 <- x[6:(n-1)]
-ym2 <- x[5:(n-2)]
-H <- cbind(x[4:(n-3)],x[3:(n-4)],x[2:(n-5)],x[1:(n-6)])
-g <- y~ym1+ym2
-x <- H
-
-res <- gel(g,x,c(0,.3,.6))
-formula(res)
-}
Deleted: pkg/gmm/man/formula.gmm.Rd
===================================================================
--- pkg/gmm/man/formula.gmm.Rd 2009-12-03 03:14:37 UTC (rev 5)
+++ pkg/gmm/man/formula.gmm.Rd 2009-12-03 03:39:00 UTC (rev 6)
@@ -1,30 +0,0 @@
-\name{formula.gmm}
-\alias{formula.gmm}
-\title{Formula method for gmm objects}
-\description{
- Method to extract the formula from \code{gmm} objects produced by \code{\link{gmm}}.
-}
-\usage{
-\method{formula}{gmm}(x, ...)
-}
-\arguments{
- \item{x}{An object of class \code{gmm} returned by the function \code{\link{gmm}}}
-\item{...}{Other arguments to pass to other methods}
-}
-
-\examples{
-
-# GMM is like GLS for linear models without endogeneity problems
-
-set.seed(345)
-n = 200
-phi<-c(.2,.7)
-thet <- 0
-sd <- .2
-x <- matrix(arima.sim(n=n,list(order=c(2,0,1),ar=phi,ma=thet,sd=sd)),ncol=1)
-y <- 10+5*rnorm(n) + x
-
-res <- gmm(y~x,x)
-formula(res)
-}
-
Deleted: pkg/gmm/man/get_dat.Rd
===================================================================
--- pkg/gmm/man/get_dat.Rd 2009-12-03 03:14:37 UTC (rev 5)
+++ pkg/gmm/man/get_dat.Rd 2009-12-03 03:39:00 UTC (rev 6)
@@ -1,39 +0,0 @@
-\name{get_dat}
-\alias{get_dat}
-\title{Extracting data from a formula}
-\description{
-It extract the data from a formula y~z with instrument h and put everything in a matrix. It helps redefine the function \eqn{g(\theta,x)} that is required by \code{\link{gmm}} and \code{\link{gel}}.
-}
-\usage{
-get_dat(formula,h)
-}
-\arguments{
-\item{formula}{A formula that defines the linear model to be estimated (see details).}
-\item{h}{A \eqn{n\times nh} matrix of intruments(see details).}
-}
[TRUNCATED]
To get the complete diff run:
svnlook diff /svnroot/gmm -r 6
More information about the Gmm-commits
mailing list