[Gmm-commits] r70 - in pkg/gmm: . R man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Wed Apr 3 01:38:03 CEST 2013
Author: chaussep
Date: 2013-04-03 01:38:02 +0200 (Wed, 03 Apr 2013)
New Revision: 70
Modified:
pkg/gmm/DESCRIPTION
pkg/gmm/NAMESPACE
pkg/gmm/NEWS
pkg/gmm/R/Methods.gmm.R
pkg/gmm/R/getModel.R
pkg/gmm/R/gmm.R
pkg/gmm/R/momentEstim.R
pkg/gmm/man/bread.Rd
pkg/gmm/man/estfun.Rd
pkg/gmm/man/summary.Rd
pkg/gmm/man/vcov.Rd
Log:
tsls and gmm with iid modified
Modified: pkg/gmm/DESCRIPTION
===================================================================
--- pkg/gmm/DESCRIPTION 2013-02-25 19:09:11 UTC (rev 69)
+++ pkg/gmm/DESCRIPTION 2013-04-02 23:38:02 UTC (rev 70)
@@ -1,6 +1,6 @@
Package: gmm
-Version: 1.4-6
-Date: 2013-02-25
+Version: 1.5-0
+Date: 2013-04-02
Title: Generalized Method of Moments and Generalized Empirical
Likelihood
Author: Pierre Chausse <pchausse at uwaterloo.ca>
Modified: pkg/gmm/NAMESPACE
===================================================================
--- pkg/gmm/NAMESPACE 2013-02-25 19:09:11 UTC (rev 69)
+++ pkg/gmm/NAMESPACE 2013-04-02 23:38:02 UTC (rev 70)
@@ -8,7 +8,8 @@
specTest.gmm, specTest.gel, print.specTest, momentEstim.baseGmm.twoStep, momentEstim.baseGmm.twoStep.formula,
momentEstim.baseGmm.iterative.formula, momentEstim.baseGmm.iterative, momentEstim.baseGmm.cue.formula,
momentEstim.baseGmm.cue, getModel.baseGmm, getModel.baseGel, getModel.constGmm, FinRes.baseGmm.res, momentEstim.baseGel.mod,
- momentEstim.baseGel.modFormula,tsls,summary.tsls, print.summary.tsls, KTest, print.gmmTests, gmmWithConst)
+ momentEstim.baseGel.modFormula,tsls,summary.tsls, print.summary.tsls, KTest, print.gmmTests, gmmWithConst, estfun.tsls,
+ model.matrix.tsls,vcov.tsls, bread.tsls)
S3method(summary, gmm)
S3method(summary, tsls)
@@ -17,6 +18,7 @@
S3method(print, summary.gmm)
S3method(coef, gmm)
S3method(vcov, gmm)
+S3method(vcov, tsls)
S3method(confint, gmm)
S3method(fitted, gmm)
S3method(residuals, gmm)
@@ -50,9 +52,12 @@
S3method(momentEstim, baseGel.modFormula)
S3method(estfun, gmmFct)
S3method(estfun, gmm)
+S3method(estfun, tsls)
+S3method(model.matrix, tsls)
S3method(estfun, gel)
S3method(bread, gmm)
S3method(bread, gel)
+S3method(bread, tsls)
Modified: pkg/gmm/NEWS
===================================================================
--- pkg/gmm/NEWS 2013-02-25 19:09:11 UTC (rev 69)
+++ pkg/gmm/NEWS 2013-04-02 23:38:02 UTC (rev 70)
@@ -1,3 +1,9 @@
+Changes in version 1.5-0
+
+o Thanks to Eric Zivot. Many improvements are based on his testings of the package.
+o Fixed many bugs for the case in which vcov is set to iid
+o Added options to tsls(). There are options for different sandwich matrix when summary is called
+
Changes in version 1.4-6
o Added the possibility of providing data.frame() with formula to gel()
Modified: pkg/gmm/R/Methods.gmm.R
===================================================================
--- pkg/gmm/R/Methods.gmm.R 2013-02-25 19:09:11 UTC (rev 69)
+++ pkg/gmm/R/Methods.gmm.R 2013-04-02 23:38:02 UTC (rev 70)
@@ -37,13 +37,20 @@
ans$specMod <- object$specMod
ans$bw <- attr(object$w0,"Spec")$bw
ans$weights <- attr(object$w0,"Spec")$weights
+ if(object$infVcov == "iid")
+ ans$kernel <- NULL
class(ans) <- "summary.gmm"
ans
}
-summary.tsls <- function(object, ...)
+summary.tsls <- function(object, vcov = NULL, ...)
{
+ if (!is.null(vcov))
+ object$vcov=vcov
+ else
+ object$vcov=vcov(object)
ans <- summary.gmm(object)
+ ans$met <- paste(ans$met, "(Meat type = ", attr(object$vcov, "vcovType"), ")",sep="")
k <- object$dat$k
fstat <- vector()
fstat[1] <- object$fsRes[[1]]$fstatistic[1]
@@ -82,11 +89,14 @@
cat(" (",x$cue$message,")\n\n")
else
cat("\n")
- cat("Kernel: ", x$kernel)
- if (!is.null(x$bw))
- cat("(with bw = ", round(x$bw,5),")\n\n")
- else
- cat("\n\n")
+ if( !is.null(x$kernel))
+ {
+ cat("Kernel: ", x$kernel)
+ if (!is.null(x$bw))
+ cat("(with bw = ", round(x$bw,5),")\n\n")
+ else
+ cat("\n\n")
+ }
cat("Coefficients:\n")
print.default(format(x$coefficients, digits=digits),
print.gap = 2, quote = FALSE)
@@ -184,6 +194,64 @@
else
return(x)
}
+estfun.tsls <- function(x, ...)
+ {
+ model.matrix(x)*c(residuals(x))
+ }
+model.matrix.tsls <- function(object, ...)
+{
+dat <- object$dat
+ny <- dat$ny
+nh <- dat$nh
+k <- dat$k
+x <- dat$x
+n <- nrow(x)
+hm <- as.matrix(x[,(ny+k+1):(ny+k+nh)])
+xm <- as.matrix(x[,(ny+1):(ny+k)])
+xhat <- lm(xm~hm-1)$fitted
+assign <- 1:ncol(xhat)
+if (attr(object$terms,"intercept")==1)
+ assign <- assign-1
+attr(xhat,"assign") <- assign
+xhat
+}
+vcov.tsls <- function(object, type=c("Classical","HC0","HC1","HAC"), hacProp = list(), ...)
+ {
+ type <- match.arg(type)
+ if (type == "Classical")
+ {
+ sig <- sum(c(residuals(object))^2)/(nrow(object$dat$x)-object$dat$k)
+ ny <- object$dat$ny
+ nh <- object$dat$nh
+ k <- object$dat$k
+ n <- nrow(object$dat$x)
+ hm <- as.matrix(object$dat$x[,(ny+k+1):(ny+k+nh)])
+ Omega <- crossprod(hm)*sig/nrow(object$dat$x)
+ vcovType <- "Classical"
+ V <- solve(crossprod(object$G,solve(Omega,object$G)))/nrow(object$dat$x)
+ }
+ else if (strtrim(type,2) == "HC")
+ {
+ meat <- meatHC(object, type)
+ bread <- bread(object)
+ vcovType <- paste("HCCM: ", type, sep="")
+ V <- crossprod(bread, meat%*%bread)/nrow(object$dat$x)
+ }
+ else
+ {
+ object$centeredVcov <- TRUE
+ gt <- model.matrix(object)*c(residuals(object))
+ gt <- lm(gt~1)
+ arg <- c(list(x=gt,sandwich=FALSE),hacProp)
+ meat <- do.call(kernHAC, arg)
+ KType <- ifelse(is.null(hacProp$kernel), formals(kernHAC)$kernel[[2]], hacProp$kernel)
+ vcovType <- paste("HAC: ", KType, sep="")
+ bread <- bread(object)
+ V <- crossprod(bread, meat%*%bread)/nrow(object$dat$x)
+ }
+ attr(V, "vcovType") <- vcovType
+ return(V)
+ }
estfun.gmm <- function(x, ...)
{
@@ -199,11 +267,23 @@
stop("The bread matrix is singular")
return(b)
}
+bread.tsls <- function(x, ...)
+ {
+ dat <- x$dat
+ ny <- dat$ny
+ nh <- dat$nh
+ k <- dat$k
+ x <- dat$x
+ n <- nrow(x)
+ hm <- as.matrix(x[,(ny+k+1):(ny+k+nh)])
+ xm <- as.matrix(x[,(ny+1):(ny+k)])
+ xhat <- lm(xm~hm-1)$fitted
+ solve(crossprod(xhat)/n)
+ }
-
Modified: pkg/gmm/R/getModel.R
===================================================================
--- pkg/gmm/R/getModel.R 2013-02-25 19:09:11 UTC (rev 69)
+++ pkg/gmm/R/getModel.R 2013-04-02 23:38:02 UTC (rev 70)
@@ -124,15 +124,7 @@
if(is.null(object$weightsMatrix))
{
- if (object$vcov == "iid" & object$wmatrix != "ident" & object$type != "cue")
- {
- clname <- "baseGmm.twoStep.formula"
- object$type <- "Linear model with iid errors: Regular IV or 2SLS"
- }
- else
- {
- clname <- paste(class(object), ".", object$type, ".formula", sep = "")
- }
+ clname <- paste(class(object), ".", object$type, ".formula", sep = "")
}
else
{
Modified: pkg/gmm/R/gmm.R
===================================================================
--- pkg/gmm/R/gmm.R 2013-02-25 19:09:11 UTC (rev 69)
+++ pkg/gmm/R/gmm.R 2013-04-02 23:38:02 UTC (rev 70)
@@ -52,6 +52,8 @@
if(class(g) != "formula")
stop("2SLS is for linear models expressed as formula only")
ans <- gmm(g,x,data=data,vcov="iid")
+ans$met <- "Two Stage Least Squares"
+ans$call <- match.call()
class(ans) <- c("tsls","gmm")
return(ans)
}
@@ -216,17 +218,17 @@
}
else
par <- solve(crossprod(hm,xm),crossprod(hm,ym)) }
- }
gb <- matrix(colSums(g(par, dat))/n, ncol = 1)
if(inv)
value <- crossprod(gb, solve(w, gb))
else
value <- crossprod(gb, w%*%gb)
-
+ }
res <- list(par = par, value = value)
if (!is.null(type))
{
if (type == "2sls")
+ res$firstStageReg <- restsls
res$fsRes <- summary(restsls)
}
return(res)
Modified: pkg/gmm/R/momentEstim.R
===================================================================
--- pkg/gmm/R/momentEstim.R 2013-02-25 19:09:11 UTC (rev 69)
+++ pkg/gmm/R/momentEstim.R 2013-04-02 23:38:02 UTC (rev 70)
@@ -200,8 +200,13 @@
{
if (P$vcov == "iid")
{
- res2 <- .tetlin(dat, w, P$gradv, P$g, type="2sls")
- initTheta <- NULL
+ res1 <- .tetlin(dat, w, P$gradv, P$g, type="2sls")
+ initTheta <- res1$par
+ gmat <- g(res1$par, dat)
+ w <- crossprod(gmat)/n
+ res2 <- .tetlin(dat, w, P$gradv, g)
+ res2$firstStageReg <- res1$firstStageReg
+ res2$fsRes <- res1$fsRes
}
if (P$vcov == "HAC")
{
@@ -276,6 +281,11 @@
P$WSpec$sandwich$bw <- attr(w,"Spec")$bw
w <- .myKernHAC(gmat, P)
}
+ if(P$vcov == "iid")
+ {
+ gmat <- g(tet, dat)
+ w <- crossprod(gmat)/n
+ }
res <- .tetlin(dat, w, P$gradv, g)
ch <- crossprod(abs(tet- res$par)/tet)^.5
if (j>P$itermax)
Modified: pkg/gmm/man/bread.Rd
===================================================================
--- pkg/gmm/man/bread.Rd 2013-02-25 19:09:11 UTC (rev 69)
+++ pkg/gmm/man/bread.Rd 2013-04-02 23:38:02 UTC (rev 70)
@@ -1,6 +1,7 @@
\name{bread}
\alias{bread.gmm}
\alias{bread.gel}
+\alias{bread.tsls}
\title{Bread for sandwiches}
\description{
Computes the bread of the sandwich covariance matrix
@@ -8,6 +9,7 @@
\usage{
\method{bread}{gmm}(x, ...)
\method{bread}{gel}(x, ...)
+\method{bread}{tsls}(x, ...)
}
\arguments{
\item{x}{A fitted model of class \code{gmm} or \code{gel}.}
@@ -38,21 +40,21 @@
# With the identity matrix
# bread is the inverse of (G'G)
-n <- 1000
-x <- rnorm(n, mean = 4, sd = 2)
-g <- function(tet, x)
- {
- m1 <- (tet[1] - x)
- m2 <- (tet[2]^2 - (x - tet[1])^2)
- m3 <- x^3 - tet[1]*(tet[1]^2 + 3*tet[2]^2)
- f <- cbind(m1, m2, m3)
- return(f)
- }
-Dg <- function(tet, x)
- {
- jacobian <- matrix(c( 1, 2*(-tet[1]+mean(x)), -3*tet[1]^2-3*tet[2]^2,0, 2*tet[2],-6*tet[1]*tet[2]), nrow=3,ncol=2)
- return(jacobian)
- }
+n <- 1000
+x <- rnorm(n, mean = 4, sd = 2)
+g <- function(tet, x)
+ {
+ m1 <- (tet[1] - x)
+ m2 <- (tet[2]^2 - (x - tet[1])^2)
+ m3 <- x^3 - tet[1]*(tet[1]^2 + 3*tet[2]^2)
+ f <- cbind(m1, m2, m3)
+ return(f)
+ }
+Dg <- function(tet, x)
+ {
+ jacobian <- matrix(c( 1, 2*(-tet[1]+mean(x)), -3*tet[1]^2-3*tet[2]^2,0, 2*tet[2],-6*tet[1]*tet[2]), nrow=3,ncol=2)
+ return(jacobian)
+ }
res <- gmm(g, x, c(0, 0), grad = Dg,weightsMatrix=diag(3))
G <- Dg(res$coef, x)
Modified: pkg/gmm/man/estfun.Rd
===================================================================
--- pkg/gmm/man/estfun.Rd 2013-02-25 19:09:11 UTC (rev 69)
+++ pkg/gmm/man/estfun.Rd 2013-04-02 23:38:02 UTC (rev 70)
@@ -2,6 +2,8 @@
\alias{estfun.gmmFct}
\alias{estfun.gmm}
\alias{estfun.gel}
+\alias{estfun.tsls}
+\alias{model.matrix.tsls}
\title{Extracts the empirical moment function}
\description{
It extracts the matrix of empirical moments so that it can be used by the \code{\link{kernHAC}} function.
@@ -10,9 +12,12 @@
\method{estfun}{gmmFct}(x, y = NULL, theta = NULL, ...)
\method{estfun}{gmm}(x, ...)
\method{estfun}{gel}(x, ...)
+\method{estfun}{tsls}(x, ...)
+\method{model.matrix}{tsls}(object, ...)
}
\arguments{
-\item{x}{A function of the form \eqn{g(\theta,y)} or a \eqn{n \times q} matrix with typical element \eqn{g_i(\theta,y_t)} for \eqn{i=1,...q} and \eqn{t=1,...,n} or an object of class \code{gmm}. See \code{\link{gmm}} for more details.}
+\item{x}{A function of the form \eqn{g(\theta,y)} or a \eqn{n \times q} matrix with typical element \eqn{g_i(\theta,y_t)} for \eqn{i=1,...q} and \eqn{t=1,...,n} or an object of class \code{gmm}. See \code{\link{gmm}} for more details. For \code{\link{tsls}}, it is an object of class \code{tsls}.}
+\item{object}{An object of class \code{tsls}.}
\item{y}{The matrix or vector of data from which the function \eqn{g(\theta,y)} is computed if \code{g} is a function.}
\item{theta}{Vector of parameters if \code{g} is a function.}
\item{...}{Other arguments when \code{estfun} is applied to another class object}
@@ -24,6 +29,8 @@
For \code{estfun.gmm}, it returns the matrix of first order conditions of \eqn{\min_\theta \bar{g}'W\bar{g}/2}, which is a \eqn{n \times k} matrix with the \eqn{t^{th}} row being \eqn{g(\theta, y_t)W G}, where \eqn{G} is \eqn{d\bar{g}/d\theta}. It allows to compute the sandwich covariance matrix using \code{\link{kernHAC}} or \code{\link{vcovHAC}} when \eqn{W} is not the optimal matrix.
The method if not yet available for \code{gel} objects.
+
+For tsls, model.matrix and estfun are used by \code{vcov()} to compute different covariance matrices using the \code{\link{sandwich}} package. See \code{\link{vcov.tsls}}. \code{model.matrix} returns the fitted values frin the first stage regression and \code{esfun} the residuals.
}
\value{
Modified: pkg/gmm/man/summary.Rd
===================================================================
--- pkg/gmm/man/summary.Rd 2013-02-25 19:09:11 UTC (rev 69)
+++ pkg/gmm/man/summary.Rd 2013-04-02 23:38:02 UTC (rev 70)
@@ -12,7 +12,7 @@
\usage{
\method{summary}{gmm}(object, ...)
\method{summary}{gel}(object, ...)
-\method{summary}{tsls}(object, ...)
+\method{summary}{tsls}(object, vcov = NULL, ...)
\method{print}{summary.gmm}(x, digits = 5, ...)
\method{print}{summary.gel}(x, digits = 5, ...)
\method{print}{summary.tsls}(x, digits = 5, ...)
@@ -21,6 +21,7 @@
\item{object}{An object of class \code{gmm} or \code{gel} returned by the function \code{\link{gmm}} or \code{\link{gel}}}
\item{x}{An object of class \code{summary.gmm} or \code{summary.gel} returned by the function \code{\link{summary.gmm}} \code{\link{summary.gel}}}
\item{digits}{The number of digits to be printed}
+\item{vcov}{An alternative covariance matrix computed with \code{vcov.tsls}}
\item{...}{Other arguments when summary is applied to another class object}
}
Modified: pkg/gmm/man/vcov.Rd
===================================================================
--- pkg/gmm/man/vcov.Rd 2013-02-25 19:09:11 UTC (rev 69)
+++ pkg/gmm/man/vcov.Rd 2013-04-02 23:38:02 UTC (rev 70)
@@ -1,6 +1,7 @@
\name{vcov}
\alias{vcov.gmm}
\alias{vcov.gel}
+\alias{vcov.tsls}
\title{Variance-covariance matrix of GMM or GEL}
\description{
It extracts the matrix of variances and covariances from \code{gmm} or \code{gel} objects.
@@ -8,13 +9,21 @@
\usage{
\method{vcov}{gmm}(object, ...)
\method{vcov}{gel}(object, lambda = FALSE, ...)
+\method{vcov}{tsls}(object, type=c("Classical","HC0","HC1","HAC"), hacProp = list(), ...)
}
\arguments{
\item{object}{An object of class \code{gmm} or \code{gmm} returned by the function \code{\link{gmm}} or \code{\link{gel}}}
\item{lambda}{If set to TRUE, the covariance matrix of the Lagrange multipliers is produced.}
+\item{type}{Type of covariance matrix for the meat}
+\item{hacProp}{A list of arguments to pass to \code{\link{kernHAC}}}
\item{...}{Other arguments when \code{vcov} is applied to another class object}
}
+\details{
+For tsls(), if vcov is set to a different value thand "Classical", a sandwich covariance matrix is computed.
+
+}
+
\value{
A matrix of variances and covariances
}
More information about the Gmm-commits
mailing list