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

[noreply at r-forge.r-project.org]

Author: chaussep
Date: 2017-09-26 21:18:02 +0200 (Tue, 26 Sep 2017)
New Revision: 116

Modified:
   pkg/gmm/DESCRIPTION
   pkg/gmm/NAMESPACE
   pkg/gmm/R/ategel.R
   pkg/gmm/man/ATEgel.Rd
Log:
Added checkConv() to check the moment balancing of ATEgel

Modified: pkg/gmm/DESCRIPTION
===================================================================
--- pkg/gmm/DESCRIPTION	2017-08-24 13:12:41 UTC (rev 115)
+++ pkg/gmm/DESCRIPTION	2017-09-26 19:18:02 UTC (rev 116)
@@ -1,6 +1,6 @@
 Package: gmm
 Version: 1.6-2
-Date: 2017-06-13
+Date: 2017-09-26
 Title: Generalized Method of Moments and Generalized Empirical
         Likelihood
 Author: Pierre Chausse <pchausse at uwaterloo.ca>

Modified: pkg/gmm/NAMESPACE
===================================================================
--- pkg/gmm/NAMESPACE	2017-08-24 13:12:41 UTC (rev 115)
+++ pkg/gmm/NAMESPACE	2017-09-26 19:18:02 UTC (rev 116)
@@ -16,7 +16,7 @@
        momentEstim.baseGel.eval, evalGel, confint.gmm, print.confint, sysGmm, getModel.sysGmm, momentEstim.sysGmm.twoStep.formula,
        momentEstim.tsls.twoStep.formula, getModel.tsls, summary.sysGmm, print.sysGmm, print.summary.sysGmm,
        sur, threeSLS, randEffect, five, bwWilhelm, getModel.ateGel, ATEgel,
-       summary.ategel, vcov.ategel, confint.ategel, marginal, marginal.ategel)
+       summary.ategel, vcov.ategel, confint.ategel, marginal, marginal.ategel,checkConv)
 
 S3method(marginal, ategel)
 S3method(summary, gmm)

Modified: pkg/gmm/R/ategel.R
===================================================================
--- pkg/gmm/R/ategel.R	2017-08-24 13:12:41 UTC (rev 115)
+++ pkg/gmm/R/ategel.R	2017-09-26 19:18:02 UTC (rev 116)
@@ -302,3 +302,48 @@
                             paste("Treat", 1:(k-1) , " versus Control", sep=""))
         coef
     }
+
+checkConv <- function(obj, tolConv=1e-4,verbose=TRUE)
+    {
+        if (!any(class(obj)=="ategel"))
+            stop("The function is for ategel objects produced by ATEgel()")
+        momType <- obj$allArg$momType
+        popMom <-  obj$allArg$popMom
+        conv <- c(Lambda=obj$conv_lambda$convergence==0, Coef= obj$conv_par == 0)
+        
+        dat <- obj$dat$x
+        nZ <- attr(obj$dat, "k")-1
+        z <- dat[,3:(2+nZ),drop=FALSE]
+        x <- dat[,-(1:(2+nZ)),drop=FALSE]
+        pt <- obj$pt
+        pt1 <- lapply(1:nZ, function(i) pt[z[,i]==1]/sum(pt[z[,i]==1]))
+        pt0 <- pt[rowSums(z)==0]/sum(pt[rowSums(z)==0])
+        m0 <- colSums(x[rowSums(z)==0,,drop=FALSE]*pt0)
+        m1 <- sapply(1:nZ, function(i) colSums(x[z[,i]==1,,drop=FALSE]*pt1[[i]]))
+        mAll <- cbind(m0, m1)
+        n0 <- paste(paste(colnames(z),collapse="=", sep=""),"=0",sep="")
+        colnames(mAll) <- c(n0, paste(colnames(z),"=1",sep=""))
+        if (!is.null(popMom))
+            {
+                m <- popMom
+            } else {
+                m <- switch(momType,
+                            bal=m0,
+                            balSample=colMeans(x),
+                            ATT=c(m1))
+            }
+        chk <- all(abs(mAll-m)<tolConv)
+        conv <- c(conv, Balance=all(chk))        
+        if (verbose)
+            {
+                cat("Convergence details of the ATEgel estimation\n")
+                cat("********************************************\n")
+                cat(obj$typeDesc,"\n\n")
+                cat("Convergence of the Lambdas: ", conv["Lambda"], "\n",sep="")
+                cat("Convergence of the Coefficients: ", conv["Coef"], "\n",sep="")
+                cat("Achieved moment balancing: ", conv["Balance"], "\n\n",sep="")
+                cat("Moments for each group:\n")
+                print.default(mAll, quote=FALSE, right=TRUE)
+            }
+        return(list(conv=conv, moments=mAll))
+    }

Modified: pkg/gmm/man/ATEgel.Rd
===================================================================
--- pkg/gmm/man/ATEgel.Rd	2017-08-24 13:12:41 UTC (rev 115)
+++ pkg/gmm/man/ATEgel.Rd	2017-09-26 19:18:02 UTC (rev 116)
@@ -1,6 +1,7 @@
 \name{ATEgel}
 
 \alias{ATEgel}
+\alias{checkConv}
 
 \title{ATE with Generalized Empirical Likelihood estimation}
 
@@ -17,14 +18,18 @@
                    optlam = c("nlminb", "optim", "iter", "Wu"), data=NULL,
                    Lambdacontrol = list(),
                    model = TRUE, X = FALSE, Y = FALSE, ...)
+checkConv(obj, tolConv=1e-4, verbose=TRUE)
 }
 \arguments{
 \item{g}{A formula as \code{y~z}, where code{y} is the response and
   \code{z} the treatment indicator. If there is more than one
   treatment, more indicators can be added or \code{z} can be set as a
   factor. It can also be of the form
-  \code{g(theta, y, z)} for non-linear models. It is however, not implemented yet.}
+  \code{g(theta, y, z)} for non-linear models. It is however, not
+  implemented yet.}
 
+\item{obj}{Object of class \code{"ategel"} produced y \code{ATEgel}}
+
 \item{balm}{A formula for the moments to be balanced between the treated
   and control groups (see details)}
 
@@ -76,6 +81,10 @@
 
 \item{model, X, Y}{logicals.  If \code{TRUE} the corresponding components of the fit (the model frame, the model matrix, the response) are returned if g is a formula.}
 
+\item{verbose}{If TRUE, a summary of the convergence is printed}
+
+\item{tolConv}{The tolerance for comparing moments between groups}
+
 \item{...}{More options to give to \code{\link{optim}} or \code{\link{nlminb}}.}
 
 }
@@ -132,9 +141,11 @@
 res <- ATEgel(re78~treat, ~age+ed+black+hisp+married+nodeg+re75,
 data=nsw,type="ET")
 summary(res)
+chk <- checkConv(res)
 
 res2 <- ATEgel(re78~treat, ~age+ed+black+hisp+married+nodeg+re75,
 data=nsw,type="ET", momType="balSample")
 summary(res2)
+chk2 <- checkConv(res2)
 
 }