[Gmm-commits] r10 - in pkg/gmm: R man

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Thu Dec 3 07:30:24 CET 2009


Author: chaussep
Date: 2009-12-03 07:30:24 +0100 (Thu, 03 Dec 2009)
New Revision: 10

Added:
   pkg/gmm/R/specTest.R
   pkg/gmm/man/specTest.Rd
Modified:
   pkg/gmm/R/Methods.gel.R
   pkg/gmm/R/Methods.gmm.R
Log:
Created a new method to compute over-identifying restrictions


Modified: pkg/gmm/R/Methods.gel.R
===================================================================
--- pkg/gmm/R/Methods.gel.R	2009-12-03 03:47:05 UTC (rev 9)
+++ pkg/gmm/R/Methods.gel.R	2009-12-03 06:30:24 UTC (rev 10)
@@ -85,9 +85,10 @@
 	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),
+	cat("\n",x$stest$ntest,"\n")
+	print.default(format(x$stest$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")
 	
@@ -98,9 +99,6 @@
 	{
 	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
@@ -109,11 +107,6 @@
 	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"
 	
@@ -125,8 +118,7 @@
     	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"))	
+	ans$stest=specTest(z)
 
 	if (z$type == "EL")
 		ans$badrho <- z$badrho

Modified: pkg/gmm/R/Methods.gmm.R
===================================================================
--- pkg/gmm/R/Methods.gmm.R	2009-12-03 03:47:05 UTC (rev 9)
+++ pkg/gmm/R/Methods.gmm.R	2009-12-03 06:30:24 UTC (rev 10)
@@ -18,24 +18,37 @@
 	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$stest <- specTest(z)
 
-	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
 	}
 
+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("\n")
+	cat(x$stest$ntest,"\n")
+	print.default(format(x$stest$test, digits=digits),
+                      print.gap = 2, quote = FALSE)
+	cat("\n")
+	invisible(x)
+	}
 
+
 formula.gmm <- function(x, ...)
 {
     if(is.null(x$terms))
@@ -90,22 +103,7 @@
 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)
-	}
 
 
 
@@ -114,7 +112,6 @@
 
 
 
-
 		
 
 

Added: pkg/gmm/R/specTest.R
===================================================================
--- pkg/gmm/R/specTest.R	                        (rev 0)
+++ pkg/gmm/R/specTest.R	2009-12-03 06:30:24 UTC (rev 10)
@@ -0,0 +1,44 @@
+specTest <- function(x, ...)
+{
+  UseMethod("specTest")
+}
+
+specTest.gmm <- function(x, ...)
+	{
+	j <- x$objective*x$n
+	J_test <- noquote(paste("J-Test: degrees of freedom is ",x$df,sep=""))
+	j <- noquote(cbind(j,ifelse(x$df>0,pchisq(j,x$df,lower.tail = FALSE),"*******")))
+	dimnames(j) <- list("Test E(g)=0:  ",c("J-test","P-value"))
+	ans<-list(ntest=J_test,test=j)
+	class(ans) <- "specTest"
+	ans
+	}
+
+print.specTest <- function(x, digits=5, ...)
+	{
+	cat("\n","## ",x$ntest," ##","\n\n")
+	print.default(format(x$test, digits=digits),
+                      print.gap = 2, quote = FALSE)
+	cat("\n")
+	invisible(x)
+	}
+
+specTest.gel <- function(x, ...)
+	{
+	n <- nrow(x$gt)
+	khat <- crossprod(x$gt)/n
+	gbar <- colMeans(x$gt)
+	LR_test <- 2*x$objective*n
+	LM_test <- n*crossprod(x$lambda,crossprod(khat,x$lambda))
+	J_test <- n*crossprod(gbar,solve(khat,gbar))
+	test <- c(LR_test,LM_test,J_test)
+	df <- (ncol(x$gt)-length(x$par))
+	ntest <- noquote(paste("Over-identifying restrictions tests: degrees of freedom is ",df,sep=""))
+	vptest <- pchisq(test,df,lower.tail=FALSE)
+	test <- cbind(test,vptest)
+	dimnames(test) <- list(c("LR test","LM test","J test"),c("statistics","p-value"))	
+	ans <- list(test=test,ntest=ntest)
+	class(ans) <- "specTest"
+	ans
+	}
+

Added: pkg/gmm/man/specTest.Rd
===================================================================
--- pkg/gmm/man/specTest.Rd	                        (rev 0)
+++ pkg/gmm/man/specTest.Rd	2009-12-03 06:30:24 UTC (rev 10)
@@ -0,0 +1,68 @@
+\name{specTest}
+\alias{specTest}
+\alias{specTest.gel}
+\alias{specTest.gmm}
+\alias{print.specTest}
+
+\title{Compute tests of specification}
+\description{
+ Generic function for testing the specification of estimated models. It computes the J-test from \code{gmm} objects and J-test, LR-test and LM-test from 
+\code{gel} objects.
+}
+\usage{
+\method{specTest}{gmm}(x, ...)
+\method{specTest}{gel}(x, ...)
+\method{print}{specTest}(x, digits = 5, ...)
+specTest(x, \dots)
+}
+\arguments{
+ \item{x}{A fitted model object.}
+ \item{digits}{The number of digits to be printed.}
+ \item{\dots}{Arguments passed to methods.}
+}
+
+\value{
+Tests and p-values
+}
+
+\references{
+
+ Hansen, L.P. (1982),
+  Large Sample Properties of Generalized Method of Moments Estimators.
+  \emph{Econometrica}, \bold{50},
+  1029-1054,
+
+ Smith, R. J. (2004),
+ GEL Criteria for Moment Condition Models.
+ \emph{CeMMAP working papers, Institute for Fiscal Studies}
+ 
+}
+
+
+
+\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)
+specTest(res)
+
+###################
+res <- gmm(g, x)
+specTest(res)
+
+}
+



More information about the Gmm-commits mailing list