[Gmm-commits] r146 - in pkg: causalGel/R gmm4/R

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Fri Oct 18 23:31:42 CEST 2019


Author: chaussep
Date: 2019-10-18 23:31:41 +0200 (Fri, 18 Oct 2019)
New Revision: 146

Modified:
   pkg/causalGel/R/causalGel.R
   pkg/gmm4/R/gel.R
   pkg/gmm4/R/gelModels-methods.R
Log:
fixed a bug in gmm4 for GEL

Modified: pkg/causalGel/R/causalGel.R
===================================================================
--- pkg/causalGel/R/causalGel.R	2019-10-18 17:38:00 UTC (rev 145)
+++ pkg/causalGel/R/causalGel.R	2019-10-18 21:31:41 UTC (rev 146)
@@ -16,9 +16,9 @@
         }    
     tmp_model <- gmm4:::.lGmmData(g, balm, data)
     if (attr(terms(tmp_model$modelF), "intercept") != 1)
-        stop("You cannot remve the intercept from g")
+        stop("You cannot remove the intercept from g")
     if (attr(terms(tmp_model$instF), "intercept") != 1)
-        stop("You cannot remve the intercept from balm")
+        stop("You cannot remove the intercept from balm")
     k <- tmp_model$k
     ncoef <- 1+2*(k-1)
     name_coef <- c("control",paste("treat", 1:(k-1), sep=""),
@@ -42,7 +42,7 @@
             if (momType == "ACE") {
                 popMom <- colMeans(X[,-1, drop=FALSE])
             } else if (momType == "ACT") {
-                popMom <- colMeans(Z[X[,1+ACTmom]==1,-1, drop=FALSE])
+                popMom <- colMeans(X[Z[,1+ACTmom]==1,-1, drop=FALSE])
             }
         }    
     modData <- new("causalData", reg=tmp_model$modelF, bal=tmp_model$instF,

Modified: pkg/gmm4/R/gel.R
===================================================================
--- pkg/gmm4/R/gel.R	2019-10-18 17:38:00 UTC (rev 145)
+++ pkg/gmm4/R/gel.R	2019-10-18 21:31:41 UTC (rev 146)
@@ -169,7 +169,7 @@
         else
             conv <- list(convergence = res$convergence, counts = res$evaluations, 
                          message = res$message)    
-        return(list(lambda = l0, convergence = conv))
+        return(list(lambda = l0, convergence = conv, obj= mean(rhoFct(gmat,l0,0,k))))
     }
 
 smoothGel <- function (object, theta=NULL) 

Modified: pkg/gmm4/R/gelModels-methods.R
===================================================================
--- pkg/gmm4/R/gelModels-methods.R	2019-10-18 17:38:00 UTC (rev 145)
+++ pkg/gmm4/R/gelModels-methods.R	2019-10-18 21:31:41 UTC (rev 146)
@@ -120,7 +120,7 @@
                           res <- do.call(slv, args)
                           if (returnL)
                               return(res)
-                          evalObjective(model, theta, , res$lambda)
+                          res$obj
                       }
                   if (is.null(lambda0))
                       lambda0 <- rep(0, modelDims(object)$q)



More information about the Gmm-commits mailing list