[Gmm-commits] r179 - in pkg/causalGel: . R man vignettes

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Fri Nov 6 22:11:31 CET 2020


Author: chaussep
Date: 2020-11-06 22:11:30 +0100 (Fri, 06 Nov 2020)
New Revision: 179

Modified:
   pkg/causalGel/NAMESPACE
   pkg/causalGel/R/causalGel.R
   pkg/causalGel/man/causalGEL.Rd
   pkg/causalGel/man/causalModel.Rd
   pkg/causalGel/vignettes/causal.bib
   pkg/causalGel/vignettes/causalGel.Rnw
   pkg/causalGel/vignettes/causalGel.pdf
Log:
Added the option orthoBases to the causalGEL function

Modified: pkg/causalGel/NAMESPACE
===================================================================
--- pkg/causalGel/NAMESPACE	2020-11-05 18:41:04 UTC (rev 178)
+++ pkg/causalGel/NAMESPACE	2020-11-06 21:11:30 UTC (rev 179)
@@ -1,6 +1,6 @@
 import("momentfit")
 
-importFrom("stats", "lm", "model.response", "terms", "model.frame", "reformulate")
+importFrom("stats", "lm", "model.response", "terms", "model.frame", "reformulate", "as.formula")
 importFrom("utils", "head", "tail")
 
 importFrom("methods", is, new, show, "slot<-", "slotNames", "validObject",

Modified: pkg/causalGel/R/causalGel.R
===================================================================
--- pkg/causalGel/R/causalGel.R	2020-11-05 18:41:04 UTC (rev 178)
+++ pkg/causalGel/R/causalGel.R	2020-11-06 21:11:30 UTC (rev 179)
@@ -1,12 +1,36 @@
 ## Model builder
 
+.orth <- function (M) 
+{
+    if (length(M) == 0) 
+        return(c())
+    if (!is.numeric(M)) 
+        stop("Argument 'M' must be a numeric matrix.")
+    if (is.vector(M)) 
+        M <- matrix(c(M), nrow = length(M), ncol = 1)
+    svdM <- svd(M)
+    U <- svdM$u
+    s <- svdM$d
+    tol <- max(dim(M)) * max(s) * .Machine$double.eps
+    r <- sum(s > tol)
+    U[, 1:r, drop = FALSE]
+}
+
 causalModel <- function(g, balm, data,theta0=NULL,
                       momType=c("ACE","ACT","ACC", "uncondBal"),
-                      popMom = NULL, ACTmom=1L) 
+                      popMom = NULL, ACTmom=1L, orthoBases=FALSE) 
 {
     momType <- match.arg(momType)
     if (!is.null(popMom))
         momType <- "fixedMom"
+    if (orthoBases)
+    {
+        X <- model.matrix(balm, data)[,-1]
+        X <- .orth(X)
+        colnames(X) <- paste("Basis", 1:ncol(X), sep="")
+        balm <- as.formula(paste("~", paste(colnames(X), collapse="+")))
+        data <- cbind(data, X)
+    }    
     tmp_model <- momentfit:::.lModelData(g, balm, data)
     if (attr(terms(tmp_model$modelF), "intercept") != 1)
         stop("You cannot remove the intercept from g")
@@ -67,7 +91,8 @@
                    initTheta = c("gmm","theta0"), getVcov=FALSE,
                    lambda0=NULL, cstLHS=NULL, cstRHS=NULL,
                    lamSlv=NULL, coefSlv= c("optim","nlminb","constrOptim"),
-                   lControl=list(), tControl=list(), restrictLam=FALSE)
+                   lControl=list(), tControl=list(), restrictLam=FALSE,
+                   orthoBases=FALSE)
 {
     Call <- try(match.call(call=sys.call(sys.parent())), silent=TRUE)
     if (class(Call)=="try-error")
@@ -79,7 +104,8 @@
     if (initTheta=="theta0" & is.null(theta0))
         stop("theta0 is required when initTheta='theta0'")
 
-    model <- causalModel(g, balm, data, theta0, momType, popMom, ACTmom)
+    model <- causalModel(g, balm, data, theta0, momType, popMom, ACTmom,
+                         orthoBases)
     
     if (initTheta == "theta0")
     {

Modified: pkg/causalGel/man/causalGEL.Rd
===================================================================
--- pkg/causalGel/man/causalGEL.Rd	2020-11-05 18:41:04 UTC (rev 178)
+++ pkg/causalGel/man/causalGEL.Rd	2020-11-06 21:11:30 UTC (rev 179)
@@ -17,7 +17,8 @@
           initTheta = c("gmm","theta0"), getVcov=FALSE,
           lambda0=NULL, cstLHS=NULL, cstRHS=NULL,
           lamSlv=NULL, coefSlv= c("optim","nlminb","constrOptim"),
-          lControl=list(), tControl=list(), restrictLam=FALSE)
+          lControl=list(), tControl=list(), restrictLam=FALSE,
+          orthoBases=FALSE)
 }
 \arguments{
 
@@ -92,7 +93,12 @@
   \item{tControl}{A list of controls for the coefficient algorithm.}
 
   \item{restrictLam}{Should we restrict the lambdas for which the
-  analytical solution is 0 to be fixed at 0?}
+    analytical solution is 0 to be fixed at 0?}
+
+  \item{orthoBases}{If \code{TRUE}, the matrix of balancing moments is
+  replaced by the matrix of orthogonal bases that span the same
+  space. It is likely to be more stable and to prevent some balancing
+  moments to be collinear.}  
 	    
 }
 

Modified: pkg/causalGel/man/causalModel.Rd
===================================================================
--- pkg/causalGel/man/causalModel.Rd	2020-11-05 18:41:04 UTC (rev 178)
+++ pkg/causalGel/man/causalModel.Rd	2020-11-06 21:11:30 UTC (rev 179)
@@ -11,7 +11,7 @@
 \usage{
 causalModel(g, balm, data,theta0=NULL,
             momType=c("ACE","ACT","ACC", "uncondBal"),
-            popMom = NULL, ACTmom=1L) 
+            popMom = NULL, ACTmom=1L, orthoBases=FALSE) 
 }
 \arguments{
 
@@ -38,6 +38,11 @@
 
   \item{ACTmom}{When \code{momType} is set to 'ACT', that integer
     indicates which treated group to use to balance the covariates.}
+
+  \item{orthoBases}{If \code{TRUE}, the matrix of balancing moments is
+  replaced by the matrix of orthogonal bases that span the same
+  space. It is likely to be more stable and to prevent some balancing
+  moments to be collinear.}
    
 }
 

Modified: pkg/causalGel/vignettes/causal.bib
===================================================================
--- pkg/causalGel/vignettes/causal.bib	2020-11-05 18:41:04 UTC (rev 178)
+++ pkg/causalGel/vignettes/causal.bib	2020-11-06 21:11:30 UTC (rev 179)
@@ -67,6 +67,14 @@
     url = {http://www.stats.ox.ac.uk/pub/MASS4}
       }
 
+ at Manual{pracma,
+    title = {pracma: Practical Numerical Math Functions},
+    author = {Hans W. Borchers},
+    year = {2019},
+    note = {R package version 2.2.9},
+    url = {https://CRAN.R-project.org/package=pracma},
+  }
+
 @book{hall05,
 author = {A. R. Hall},
 title = {Generalized Method of Moments (Advanced Texts in Econometrics)},

Modified: pkg/causalGel/vignettes/causalGel.Rnw
===================================================================
--- pkg/causalGel/vignettes/causalGel.Rnw	2020-11-05 18:41:04 UTC (rev 178)
+++ pkg/causalGel/vignettes/causalGel.Rnw	2020-11-06 21:11:30 UTC (rev 179)
@@ -831,7 +831,42 @@
 rbind(fit1 at lambda, fit2 at lambda)
 @ 
 
+\subsection{Using orthogonal bases}
 
+When the number of balancing moments increases, it may become
+numerically unstable to use them directly. It is also likely that they
+become collinear. To avoid the problem, we can replace the balancing
+matrix by the matrix of orthogonal bases that span the same space. We
+borrowed the function orth() from the pracma package
+\citep{pracma}. This is done by adding the option orthoBases=TRUE. The
+following is used to compare the results, which are shown in Table
+\ref{ortho}. We can see that in most cases, there is very little
+difference. 
+
+<<>>=
+fit1 <- causalGEL(re78~treat, ~age+ed+black+hisp+re75, nsw, gelType="EL",
+                 momType="ACT")
+fit2 <- causalGEL(re78~treat, ~age+ed+black+hisp+re75, nsw, gelType="EL",
+                 momType="ACT", orthoBases=TRUE)
+@ 
+
+<<echo=FALSE, results='asis'>>=
+texreg(list(fit1, fit2), label='ortho', digits=6,
+       custom.model.names=c("Original","Orthogonal Bases"),
+       caption="Comparing estimates with and without the orthogonal bases")
+@ 
+
+The difference can be seen by looking at the ouput from the checkConv method:
+
+<<>>=
+checkConv(fit2)
+@ 
+
+The method no longer compare the moments of the original data (age,
+educ, black, etc.) but the moments of the bases. If some moments
+happen to be nearly collinear, we may see fewer bases.
+
+
 \bibliography{causal}
 
 \appendix

Modified: pkg/causalGel/vignettes/causalGel.pdf
===================================================================
(Binary files differ)



More information about the Gmm-commits mailing list