[Gmm-commits] r75 - in pkg/gmm: . R

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Tue Feb 3 22:28:40 CET 2015


Author: chaussep
Date: 2015-02-03 22:28:39 +0100 (Tue, 03 Feb 2015)
New Revision: 75

Modified:
   pkg/gmm/DESCRIPTION
   pkg/gmm/NAMESPACE
   pkg/gmm/NEWS
   pkg/gmm/R/Methods.gmm.R
   pkg/gmm/R/gmm.R
   pkg/gmm/R/momentEstim.R
Log:
fixed check warnings

Modified: pkg/gmm/DESCRIPTION
===================================================================
--- pkg/gmm/DESCRIPTION	2013-12-10 20:37:59 UTC (rev 74)
+++ pkg/gmm/DESCRIPTION	2015-02-03 21:28:39 UTC (rev 75)
@@ -1,6 +1,6 @@
 Package: gmm
-Version: 1.5-0
-Date: 2013-04-02
+Version: 1.5-1
+Date: 2015-02-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-12-10 20:37:59 UTC (rev 74)
+++ pkg/gmm/NAMESPACE	2015-02-03 21:28:39 UTC (rev 75)
@@ -1,5 +1,5 @@
 import(stats)
-importFrom(sandwich, estfun, bread)
+importFrom(sandwich, estfun, bread, kernHAC, weightsAndrews, vcovHAC, bwAndrews, meatHC)
 
 
 export(gmm,summary.gmm,smoothG,getDat,summary.gel,getLamb,gel, estfun.gmmFct, estfun.gmm, estfun.gel, bread.gel, bread.gmm, 

Modified: pkg/gmm/NEWS
===================================================================
--- pkg/gmm/NEWS	2013-12-10 20:37:59 UTC (rev 74)
+++ pkg/gmm/NEWS	2015-02-03 21:28:39 UTC (rev 75)
@@ -1,3 +1,9 @@
+Changes in version 1.5-1
+
+o Added importFrom element
+o Added element df.residual to gmm objects to allow F-type linearHypothesis 
+o Removed the unnecessary ls estimations in the first stage 2SLS
+
 Changes in version 1.5-0
 
 o Thanks to Eric Zivot. Many improvements are based on his testings of the package.

Modified: pkg/gmm/R/Methods.gmm.R
===================================================================
--- pkg/gmm/R/Methods.gmm.R	2013-12-10 20:37:59 UTC (rev 74)
+++ pkg/gmm/R/Methods.gmm.R	2015-02-03 21:28:39 UTC (rev 75)
@@ -55,13 +55,29 @@
 	if (!is.null(object$fsRes))
 		{
 		fstat <- vector()
-		fstat[1] <- object$fsRes[[1]]$fstatistic[1]
-		df1 <- object$fsRes[[1]]$fstatistic[2]
-		df2 <- object$fsRes[[1]]$fstatistic[3]
-		for (i in 2:k)	
-			fstat[i] <- object$fsRes[[i]]$fstatistic[1]
+                fsRes <- object$fsRes
+                if (class(fsRes) == "listof")
+                    {
+                    nendo <- length(fsRes)
+                } else {
+                    nendo <- 1
+                }
+                if (nendo == 1)
+                    { 
+                    fstat[1] <- fsRes$fstatistic[1]
+                    df1 <- fsRes$fstatistic[2]
+                    df2 <- fsRes$fstatistic[3]
+                } else {
+                    fstat[1] <- fsRes[[1]]$fstatistic[1]
+                    df1 <- fsRes[[1]]$fstatistic[2]
+                    df2 <- fsRes[[1]]$fstatistic[3]
+                }
+                if (nendo > 1){
+                    for (i in 2:nendo)	
+			fstat[i] <- fsRes[[i]]$fstatistic[1]
+                }
 		pvfstat <- 1-pf(fstat,df1, df2)
-		names(fstat) <- colnames(object$dat$x)[(object$dat$ny+1):(object$dat$ny+k)]
+		names(fstat) <- attr(fsRes,"Endo")
 		ans$fstatistic <- list(fstat = fstat, pvfstat = pvfstat, df1 = df1, df2 = df2)
 		}
         ans$specMod <- object$specMod

Modified: pkg/gmm/R/gmm.R
===================================================================
--- pkg/gmm/R/gmm.R	2013-12-10 20:37:59 UTC (rev 74)
+++ pkg/gmm/R/gmm.R	2015-02-03 21:28:39 UTC (rev 75)
@@ -165,17 +165,28 @@
   ym <- as.matrix(x[,1:ny])
   xm <- as.matrix(x[,(ny+1):(ny+k)])
   hm <- as.matrix(x[,(ny+k+1):(ny+k+nh)])
+  includeExo <- which(colnames(xm)%in%colnames(hm))
   if (!is.null(type))
   	{
   	if(type=="2sls")
 	  	{
-		restsls <- lm(xm~hm-1)
-  		fsls <- restsls$fitted
-  	     	par <- lm(ym~fsls-1)$coef
+                if (length(includeExo) > 0)
+                    {
+                    endo <- xm[, -includeExo, drop = FALSE]
+                    endoName <- colnames(endo)
+                    restsls <- lm(endo~hm-1)
+                    fsls <- xm
+                    fsls[, -includeExo] <- restsls$fitted
+                } else {
+                    restsls <- lm(xm~hm-1)
+                    fsls <- restsls$fitted
+                    endoName <- colnames(xm)
+                }
+  	     	par <- lm.fit(as.matrix(fsls), ym)$coefficients
 		if (ny == 1)
 		{
   	     	e2sls <- ym-xm%*%par
- 	     	v2sls <- lm(e2sls~hm-1)$fitted
+ 	     	v2sls <- lm.fit(as.matrix(hm), e2sls)$fitted
   	     	value <- sum(v2sls^2)/sum(e2sls^2)
   	     }
   	     else
@@ -230,6 +241,7 @@
      if (type == "2sls")
      res$firstStageReg <- restsls	
      res$fsRes <- summary(restsls)
+     attr(res$fsRes, "Endo") <- endoName
      }
   return(res)
   }

Modified: pkg/gmm/R/momentEstim.R
===================================================================
--- pkg/gmm/R/momentEstim.R	2013-12-10 20:37:59 UTC (rev 74)
+++ pkg/gmm/R/momentEstim.R	2015-02-03 21:28:39 UTC (rev 75)
@@ -194,7 +194,7 @@
   if (q == k2 | P$wmatrix == "ident")
     {
     res2 <- .tetlin(dat, w, P$gradv, P$g)
-    z = list(coefficients = res2$par, objective = res2$value, dat = dat, k = k, k2 = k2, n = n, q = q, df = df)
+    z = list(coefficients = res2$par, objective = res2$value, dat = dat, k = k, k2 = k2, n = n, q = q, df = df, df.residual = (n-k))
     }
   else
     {
@@ -216,7 +216,7 @@
       w <- .myKernHAC(gmat, P)
       res2 <- .tetlin(dat, w, P$gradv, g)
       }
-    z = list(coefficients = res2$par, objective = res2$value, dat=dat, k=k, k2=k2, n=n, q=q, df=df, initTheta = initTheta)	
+    z = list(coefficients = res2$par, objective = res2$value, dat=dat, k=k, k2=k2, n=n, q=q, df=df, initTheta = initTheta, df.residual = (n-k))	
     }
   z$gt <- g(z$coefficients, dat) 
   b <- z$coefficients
@@ -263,7 +263,7 @@
   if (q == k2 | P$wmatrix == "ident")
     {
     res <- .tetlin(dat, w, P$gradv, g)
-    z = list(coefficients = res$par, objective = res$value, dat = dat, k = k, k2 = k2, n = n, q = q, df = df)
+    z = list(coefficients = res$par, objective = res$value, dat = dat, k = k, k2 = k2, n = n, q = q, df = df, df.residual = (n-k))
     }
   else
     {
@@ -298,7 +298,7 @@
 		cat("Iter :",j,": value=",res$value,", Coef = ", res$par,"\n") 
         j <- j+1	
       }
-    z = list(coefficients = res$par, objective = res$value, dat=dat, k=k, k2=k2, n=n, q=q, df=df, initTheta=initTheta)	
+    z = list(coefficients = res$par, objective = res$value, dat=dat, k=k, k2=k2, n=n, q=q, df=df, initTheta=initTheta, df.residual = (n-k))	
    }
   z$gt <- g(z$coefficients, dat) 
   b <- z$coefficients
@@ -524,7 +524,7 @@
   if (q == k2 | P$wmatrix == "ident")
     {
     res <- .tetlin(dat, w, P$gradv, g)
-    z = list(coefficients = res$par, objective = res$value, dat = dat, k = k, k2 = k2, n = n, q = q, df = df)
+    z = list(coefficients = res$par, objective = res$value, dat = dat, k = k, k2 = k2, n = n, q = q, df = df, df.residual = (n-k))
     P$weightMessage <- "No CUE needed because the model is just identified"
     }
   else
@@ -569,7 +569,7 @@
       res2$par <- res2$minimum
       res2$value <- res2$objective
       }
-    z = list(coefficients = res2$par, objective = res2$value, dat = dat, k = k, k2 = k2, n = n, q = q, df = df, initTheta=initTheta)
+    z = list(coefficients = res2$par, objective = res2$value, dat = dat, k = k, k2 = k2, n = n, q = q, df = df, initTheta=initTheta, df.residual = (n-k))
     if (P$optfct == "optim")
 	z$algoInfo <- list(convergence = res2$convergence, counts = res2$counts, message = res2$message)
     else if(P$optfct == "nlminb")
@@ -909,7 +909,7 @@
     }
   
   res2 <- .tetlin(dat, w, P$gradv, g, inv=FALSE)
-  z = list(coefficients = res2$par, objective = res2$value, dat=dat, k=k, k2=k2, n=n, q=q, df=df)	
+  z = list(coefficients = res2$par, objective = res2$value, dat=dat, k=k, k2=k2, n=n, q=q, df=df, df.residual = (n-k))	
 
   z$gt <- g(z$coefficients, dat) 
   b <- z$coefficients



More information about the Gmm-commits mailing list