[Gmm-commits] r165 - in pkg: causalGel causalGel/R causalGel/man causalGel/vignettes momentfit/R

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Tue Jan 21 07:01:25 CET 2020


Author: chaussep
Date: 2020-01-21 07:01:24 +0100 (Tue, 21 Jan 2020)
New Revision: 165

Added:
   pkg/causalGel/R/rcausalMethods.R
   pkg/causalGel/man/causalModel-class.Rd
   pkg/causalGel/man/rcausalModel-class.Rd
Removed:
   pkg/causalGel/man/causalGel-class.Rd
Modified:
   pkg/causalGel/DESCRIPTION
   pkg/causalGel/NAMESPACE
   pkg/causalGel/R/allClasses.R
   pkg/causalGel/R/causalGel.R
   pkg/causalGel/R/causalMethods.R
   pkg/causalGel/R/causalfitMethods.R
   pkg/causalGel/man/causalGelfit-class.Rd
   pkg/causalGel/man/causalModel.Rd
   pkg/causalGel/man/checkConv-methods.Rd
   pkg/causalGel/man/subsetting.Rd
   pkg/causalGel/vignettes/causalGel.Rnw
   pkg/causalGel/vignettes/causalGel.pdf
   pkg/momentfit/R/rsysMomentModel-methods.R
Log:
converted causalGel to the new momentfit and fixed a bug in momentfit

Modified: pkg/causalGel/DESCRIPTION
===================================================================
--- pkg/causalGel/DESCRIPTION	2020-01-21 03:40:21 UTC (rev 164)
+++ pkg/causalGel/DESCRIPTION	2020-01-21 06:01:24 UTC (rev 165)
@@ -1,12 +1,12 @@
 Package: causalGel
 Version: 0.0-1
-Date: 2019-11-15
+Date: 2020-01-20
 Title: Causal Inference using Generalized Empirical
         Likelihood Methods
 Author: Pierre Chausse <pchausse at uwaterloo.ca>
 Maintainer: Pierre Chausse <pchausse at uwaterloo.ca>
 Description: Methods for causal inference in which covariates are balanced using generalized empirical likelihod methods.
-Depends: R (>= 3.0.0), gmm4 (>= 0.2.0)
+Depends: R (>= 3.0.0), momentfit (>= 0.1.0)
 Imports: stats, methods
 Suggests: lmtest, knitr, texreg
 Collate: 'allClasses.R' 'causalMethods.R' 'rcausalMethods.R' 'causalGel.R'

Modified: pkg/causalGel/NAMESPACE
===================================================================
--- pkg/causalGel/NAMESPACE	2020-01-21 03:40:21 UTC (rev 164)
+++ pkg/causalGel/NAMESPACE	2020-01-21 06:01:24 UTC (rev 165)
@@ -1,4 +1,4 @@
-import("gmm4")
+import("momentfit")
 
 importFrom("stats", "lm", "model.response", "terms", "model.frame", "reformulate")
 importFrom("utils", "head", "tail")
@@ -10,7 +10,7 @@
 ### S4 Methods and Classes
 exportClasses()
 
-exportClasses("causalData", "causalGel", "causalGelfit", "rcausalGel")
+exportClasses("causalData", "causalModel", "causalGelfit", "rcausalModel")
 
 exportMethods("causalMomFct", "checkConv")
 

Modified: pkg/causalGel/R/allClasses.R
===================================================================
--- pkg/causalGel/R/allClasses.R	2020-01-21 03:40:21 UTC (rev 164)
+++ pkg/causalGel/R/allClasses.R	2020-01-21 06:01:24 UTC (rev 165)
@@ -4,9 +4,9 @@
 
 ## Causal Model Classes
 
-setClass("causalGel", contains="functionGel")
+setClass("causalModel", contains="functionModel")
 
-setClass("rcausalGel", contains="rfunctionGel")
+setClass("rcausalModel", contains="rfunctionModel")
 
 setClass("causalData", representation(momType="character",
                                       balCov="character",
@@ -20,13 +20,9 @@
 
 ## converters
 
-setAs("rcausalGel", "rgmmModels",
+setAs("rcausalModel", "causalModel",
       function(from) {
-          as(as(from, "rgelModels"), "rgmmModels")})
+          obj <- as(from, "momentModel")
+          new("causalModel", obj)})
 
-setAs("rcausalGel", "causalGel",
-      function(from) {
-          obj <- as(from, "gelModels")
-          new("causalGel", obj)})
 
-

Modified: pkg/causalGel/R/causalGel.R
===================================================================
--- pkg/causalGel/R/causalGel.R	2020-01-21 03:40:21 UTC (rev 164)
+++ pkg/causalGel/R/causalGel.R	2020-01-21 06:01:24 UTC (rev 165)
@@ -2,11 +2,9 @@
 
 causalModel <- function(g, balm, data,theta0=NULL,
                       momType=c("ACE","ACT","ACC", "uncondBal","fixedMom"),
-                      popMom = NULL, rhoFct=NULL,ACTmom=1L, 
-                      gelType = c("EL", "ET", "EEL", "ETEL", "HD", "ETHD","REEL"))
+                      popMom = NULL, ACTmom=1L) 
 {
     momType <- match.arg(momType)
-    gelType <- match.arg(gelType)
     if (!is.null(popMom))
         {
             momType <- "fixedMom"
@@ -14,7 +12,7 @@
             if (momType == "fixedMom")
                 stop("With fixed moments, popMom must be provided")
         }    
-    tmp_model <- gmm4:::.lGmmData(g, balm, data)
+    tmp_model <- momentfit:::.lModelData(g, balm, data)
     if (attr(terms(tmp_model$modelF), "intercept") != 1)
         stop("You cannot remove the intercept from g")
     if (attr(terms(tmp_model$instF), "intercept") != 1)
@@ -54,9 +52,9 @@
     modData <- new("causalData", reg=tmp_model$modelF, bal=tmp_model$instF,
                    momType=momType, balMom=popMom, ACTmom=ACTmom,
                    balCov=tmp_model$momNames[-1])
-    mod <- gelModel(g=causalMomFct, x=modData, gelType=gelType, rhoFct=rhoFct,
-                    theta0=theta0, grad=NULL,vcov="MDS", vcovOptions=list(),
-                    centeredVcov=TRUE, data=NULL)
+    mod <- momentModel(g=causalMomFct, x=modData, 
+                       theta0=theta0, grad=NULL, vcov="MDS", vcovOptions=list(),
+                       centeredVcov=TRUE, data=NULL)
     momNames <- lapply(treatInd, function(i)
         paste("treat", i, "_", tmp_model$momNames[-1], sep=""))
     momNames <- do.call("c", momNames)
@@ -64,7 +62,7 @@
         mod at momNames <- c(names(theta0), momNames)
     else
         mod at momNames <- c(names(theta0), momNames, tmp_model$momNames[-1])
-    new("causalGel", mod)
+    new("causalModel", mod)
 }
 
 causalGEL <- function(g, balm, data, theta0=NULL,
@@ -86,8 +84,7 @@
     if (initTheta=="theta0" & is.null(theta0))
         stop("theta0 is required when initTheta='theta0'")
 
-    model <- causalModel(g, balm, data, theta0, momType, popMom, rhoFct, ACTmom,
-                       gelType)
+    model <- causalModel(g, balm, data, theta0, momType, popMom, ACTmom)
     
     if (initTheta == "theta0")
     {
@@ -117,9 +114,9 @@
         if (!is.null(theta0)) 
             theta0 <- theta0[(names(theta0) %in% spec$parNames)]
     }    
-    fit <- modelFit(model=model, initTheta=initTheta, theta0=theta0,
-                    lambda0=lambda0, vcov=getVcov, coefSlv=coefSlv,
-                    lamSlv=lamSlv, tControl=tControl, lControl=lControl)
+    fit <- gelFit(model=model, gelType=gelType, rhoFct=rhoFct, initTheta=initTheta, theta0=theta0,
+                  lambda0=lambda0, vcov=getVcov, coefSlv=coefSlv,
+                  lamSlv=lamSlv, tControl=tControl, lControl=lControl)
     fit at call <- Call
     fit    
 }

Modified: pkg/causalGel/R/causalMethods.R
===================================================================
--- pkg/causalGel/R/causalMethods.R	2020-01-21 03:40:21 UTC (rev 164)
+++ pkg/causalGel/R/causalMethods.R	2020-01-21 06:01:24 UTC (rev 165)
@@ -21,7 +21,7 @@
 
 ## evalDMoment functions
 
-setMethod("evalDMoment", signature("causalGel"),
+setMethod("evalDMoment", signature("causalModel"),
           function(object, theta, impProb=NULL, augmented=FALSE) {
               dat <- object at X
               Z <- model.matrix(terms(dat at reg), dat at reg)
@@ -57,11 +57,10 @@
 
 ## Print
 
-setMethod("print", "causalGel",
+setMethod("print", "causalModel",
           function(x, printBalCov=FALSE, ...) {
-              cat("Causal Model using GEL Methods\n")
-              cat("*******************************\n")
-              cat("GEL Type: ", x at gelType$name, "\n")
+              cat("Causal Model \n")
+              cat("*************\n")
               momType <- switch(x at X@momType,
                                 uncondBal = "Unconditional balancing",
                                 ACT = "Causal effect on the treated",
@@ -90,9 +89,9 @@
               invisible()
           })
 
-## modelFit
+## gelFit
 
-setMethod("modelFit", signature("causalGel"), valueClass="causalGelfit", 
+setMethod("gelFit", signature("causalModel"), valueClass="causalGelfit", 
           definition = function(model, gelType=NULL, rhoFct=NULL,
                                 initTheta=c("gmm", "modelTheta0"), theta0=NULL,
                                 lambda0=NULL, vcov=FALSE, ...)
@@ -108,7 +107,7 @@
 
 ## model.matrix and modelResponse
 
-setMethod("model.matrix", signature("causalGel"),
+setMethod("model.matrix", signature("causalModel"),
           function(object, type=c("regressors","balancingCov"))
           {
               type <- match.arg(type)
@@ -123,7 +122,7 @@
               mat
           })
 
-setMethod("modelResponse", signature("causalGel"),
+setMethod("modelResponse", signature("causalModel"),
           function(object)
           {
               model.response(object at X@reg)
@@ -133,7 +132,7 @@
 ## Residuals
 # Not sure we will need it, but the residuals are well defined in this case
 
-setMethod("residuals", signature("causalGel"), function(object, theta){
+setMethod("residuals", signature("causalModel"), function(object, theta){
     X <- model.matrix(object)
     Y <- modelResponse(object)
     e <- Y-c(X%*%theta[1:ncol(X)])
@@ -143,7 +142,7 @@
 ## Dresiduals 
 # Same comment as for residuals
 
-setMethod("Dresiduals", signature("causalGel"),
+setMethod("Dresiduals", signature("causalModel"),
           function(object, theta) {
               -model.matrix(object)
           })
@@ -150,7 +149,7 @@
 
 ## modelDims
 
-setMethod("modelDims", "causalGel",
+setMethod("modelDims", "causalModel",
           function(object) {
               res <- callNextMethod()
               res$balCov <- object at X@balCov
@@ -162,7 +161,7 @@
 
 ## subset for observations selection
 
-setMethod("subset", "causalGel",
+setMethod("subset", "causalModel",
           function(x, i) {
               x at X@reg <- x at X@reg[i,,drop=FALSE]
               x at X@bal <- x at X@bal[i,,drop=FALSE]
@@ -173,7 +172,7 @@
 ## "["
 ## balancing moment selection
 
-setMethod("[", c("causalGel", "numeric", "missing"),
+setMethod("[", c("causalModel", "numeric", "missing"),
           function(x, i, j){
               i <- unique(as.integer(i))
               spec <- modelDims(x)
@@ -197,13 +196,13 @@
               x
           })
 
-setMethod("[", c("causalGel", "numeric", "numericORlogical"),
+setMethod("[", c("causalModel", "numeric", "numericORlogical"),
           function(x, i, j){
               x <- x[i]
               subset(x, j)
           })
 
-setMethod("[", c("causalGel", "missing", "numericORlogical"),
+setMethod("[", c("causalModel", "missing", "numericORlogical"),
           function(x, i, j){
               subset(x, j)
           })

Modified: pkg/causalGel/R/causalfitMethods.R
===================================================================
--- pkg/causalGel/R/causalfitMethods.R	2020-01-21 03:40:21 UTC (rev 164)
+++ pkg/causalGel/R/causalfitMethods.R	2020-01-21 06:01:24 UTC (rev 165)
@@ -9,16 +9,17 @@
     q <- spec$q
     k <- spec$k
     ncov <- length(spec$balCov)
-    Wk <- object at model@wSpec$k
+    Wk <- object at model@sSpec at k
     lam <- object at lambda
     theta <- coef(object)
     gt <- evalMoment(object at model, theta)
-    rhoFct <- object at model@gelType
-    if (is.null(rhoFct$fct))
+    rhoFct <- object at gelType$rhoFct
+    gelType <- object at gelType$name
+    if (is.null(rhoFct))
     {
-        rhoFct <- get(paste("rho", rhoFct$name, sep = ""))
+        rhoFct <- get(paste("rho", gelType, sep = ""))
     } else {
-        rhoFct <- rhoFct$fct
+        rhoFct <- rhoFct
     }
     rho1 <- rhoFct(gmat=gt, lambda=lam, derive=1, k=Wk[1]/Wk[2])
     rho2 <- rhoFct(gmat=gt, lambda=lam, derive=2, k=Wk[1]/Wk[2])
@@ -87,8 +88,9 @@
               theta <- coef(x)
               if (model)
                   print(x at model)
-              type <- x at type
+              type <- x at gelType$name
               spec <- modelDims(x at model)
+              cat("\nEstimation: ", type, "\n")
               cat("Convergence Theta: ", x at convergence, "\n")
               cat("Convergence Lambda: ", x at lconvergence, "\n")              
               cat("coefficients:\n")
@@ -111,7 +113,7 @@
                       FALSE)
                       return(allV)
                   }
-              if (inherits(object at model, "rcausalGel"))
+              if (inherits(object at model, "rcausalModel"))
               {
                   allV <- getMethod("vcov","gelfit")(object, withImpProb, tol, TRUE)
                   return(allV)                  

Added: pkg/causalGel/R/rcausalMethods.R
===================================================================
--- pkg/causalGel/R/rcausalMethods.R	                        (rev 0)
+++ pkg/causalGel/R/rcausalMethods.R	2020-01-21 06:01:24 UTC (rev 165)
@@ -0,0 +1,78 @@
+## restricted model constructor
+
+setMethod("restModel", signature("causalModel"),
+          function(object, R, rhs=NULL)
+          {
+              mod <- restModel(as(object, "momentModel"), R, rhs)
+              new("rcausalModel", mod)
+          })
+
+
+## print
+
+setMethod("print", "rcausalModel",
+          function(x)
+          {
+              print(as(x, "causalModel"))
+              cat("Additional Specifications: Restricted model\n")
+              printRestrict(x)
+          })
+
+
+## modelFit
+
+setMethod("gelFit", signature("rcausalModel"), valueClass="causalGelfit", 
+          definition = function(model, gelType=NULL, rhoFct=NULL,
+                                initTheta=c("gmm", "modelTheta0"), theta0=NULL,
+                                lambda0=NULL, vcov=FALSE, ...)
+          {
+              Call <- try(match.call(call=sys.call(sys.parent())), silent=TRUE)
+              if (inherits(Call,"try-error"))
+                  Call <- NULL              
+              res <- callNextMethod()
+              res at call <- Call
+              obj <- new("causalGelfit", res)
+              obj
+          })
+
+
+## modelDims
+
+setMethod("modelDims", "rcausalModel",
+          function(object) {
+              res <- callNextMethod()
+              res$balCov <- object at X@balCov
+              res$momType <- object at X@momType
+              res$balMom <- object at X@balMom
+              res$ACTmom <- object at X@ACTmom
+              res
+          })
+
+
+## subsetting
+
+setMethod("subset", "rcausalModel",
+          function(x, i) {
+              x at X@reg <- x at X@reg[i,,drop=FALSE]
+              x at X@bal <- x at X@bal[i,,drop=FALSE]
+              x at n <- nrow(x at X@reg)
+              x})
+
+setMethod("[", c("rcausalModel", "numeric", "missing"),
+          function(x, i, j){
+              obj <- as(x, "causalModel")[i]
+              mod <- new("rfunctionModel", R=x at R, cstSpec=x at cstSpec, obj)
+              new("rcausalGel", mod)
+          })
+
+setMethod("[", c("rcausalModel", "numeric", "numericORlogical"),
+          function(x, i, j){
+              x <- x[i]
+              subset(x, j)
+          })
+
+setMethod("[", c("rcausalModel", "missing", "numericORlogical"),
+          function(x, i, j){
+              subset(x, j)
+          })
+

Deleted: pkg/causalGel/man/causalGel-class.Rd
===================================================================
--- pkg/causalGel/man/causalGel-class.Rd	2020-01-21 03:40:21 UTC (rev 164)
+++ pkg/causalGel/man/causalGel-class.Rd	2020-01-21 06:01:24 UTC (rev 165)
@@ -1,50 +0,0 @@
-\name{causalGel-class}
-\docType{class}
-\alias{causalGel-class}
-\alias{causalGel}
-
-\title{Class \code{"causalGel"}}
-\description{
-This is the basic class for causality models. 
-}
-\section{Objects from the Class}{
-Objects can be created by calls of the form \code{new("causalGel", ...)}.
-It is however, recommended to use the constructor \code{aceModel}.
-}
-\section{Slots}{
-  \describe{
-    \item{\code{wSpec}:}{Object of class \code{"list"} ~~ }
-    \item{\code{gelType}:}{Object of class \code{"list"} ~~ }
-    \item{\code{X}:}{Object of class \code{"ANY"} ~~ }
-    \item{\code{fct}:}{Object of class \code{"function"} ~~ }
-    \item{\code{dfct}:}{Object of class \code{"functionORNULL"} ~~ }
-    \item{\code{vcov}:}{Object of class \code{"character"} ~~ }
-    \item{\code{theta0}:}{Object of class \code{"numeric"} ~~ }
-    \item{\code{n}:}{Object of class \code{"integer"} ~~ }
-    \item{\code{q}:}{Object of class \code{"integer"} ~~ }
-    \item{\code{k}:}{Object of class \code{"integer"} ~~ }
-    \item{\code{parNames}:}{Object of class \code{"character"} ~~ }
-    \item{\code{momNames}:}{Object of class \code{"character"} ~~ }
-    \item{\code{vcovOptions}:}{Object of class \code{"list"} ~~ }
-    \item{\code{centeredVcov}:}{Object of class \code{"logical"} ~~ }
-    \item{\code{varNames}:}{Object of class \code{"character"} ~~ }
-    \item{\code{isEndo}:}{Object of class \code{"logical"} ~~ }
-    \item{\code{omit}:}{Object of class \code{"integer"} ~~ }
-    \item{\code{survOptions}:}{Object of class \code{"list"} ~~ }
-  }
-}
-\section{Extends}{
-Class \code{"\linkS4class{functionGel}"}, directly.
-Class \code{"\linkS4class{functionGmm}"}, by class "functionGel", distance 2.
-Class \code{"\linkS4class{gelModels}"}, by class "functionGel", distance 2.
-Class \code{"\linkS4class{allNLGmm}"}, by class "functionGel", distance 3.
-Class \code{"\linkS4class{gmmModels}"}, by class "functionGel", distance 3.
-}
-\section{Methods}{
-No methods defined with class "causalGel" in the signature.
-}
-
-\examples{
-showClass("causalGel")
-}
-\keyword{classes}

Modified: pkg/causalGel/man/causalGelfit-class.Rd
===================================================================
--- pkg/causalGel/man/causalGelfit-class.Rd	2020-01-21 03:40:21 UTC (rev 164)
+++ pkg/causalGel/man/causalGelfit-class.Rd	2020-01-21 06:01:24 UTC (rev 165)
@@ -4,7 +4,7 @@
 
 \title{Class \code{"causalGelfit"}}
 \description{
-A class model causal models based on GEL methods.
+A class to store the fiited causality model obtained using the GEL method.
 }
 \section{Objects from the Class}{
 Objects can be created by calls of the form \code{new("causalGelfit",
@@ -17,9 +17,9 @@
     \item{\code{lambda}:}{Object of class \code{"numeric"} ~~ }
     \item{\code{lconvergence}:}{Object of class \code{"numeric"} ~~ }
     \item{\code{call}:}{Object of class \code{"callORNULL"} ~~ }
-    \item{\code{type}:}{Object of class \code{"character"} ~~ }
+    \item{\code{gelType}:}{Object of class \code{"list"} ~~ }
     \item{\code{vcov}:}{Object of class \code{"list"} ~~ }
-    \item{\code{model}:}{Object of class \code{"gelModels"} ~~ }
+    \item{\code{model}:}{Object of class \code{"momentModel"} ~~ }
   }
 }
 \section{Extends}{

Added: pkg/causalGel/man/causalModel-class.Rd
===================================================================
--- pkg/causalGel/man/causalModel-class.Rd	                        (rev 0)
+++ pkg/causalGel/man/causalModel-class.Rd	2020-01-21 06:01:24 UTC (rev 165)
@@ -0,0 +1,46 @@
+\name{causalModel-class}
+\docType{class}
+\alias{causalModel-class}
+
+\title{Class \code{"causalGel"}}
+\description{
+This is the basic class for causality models. 
+}
+\section{Objects from the Class}{
+Objects can be created by calls of the form \code{new("causalModel", ...)}.
+It is however, recommended to use the constructor \code{\link{causalModel}}.
+}
+\section{Slots}{
+  \describe{
+    \item{\code{X}:}{Object of class \code{"ANY"} ~~ }
+    \item{\code{fct}:}{Object of class \code{"function"} ~~ }
+    \item{\code{dfct}:}{Object of class \code{"functionORNULL"} ~~ }
+    \item{\code{vcov}:}{Object of class \code{"character"} ~~ }
+    \item{\code{theta0}:}{Object of class \code{"numeric"} ~~ }
+    \item{\code{n}:}{Object of class \code{"integer"} ~~ }
+    \item{\code{q}:}{Object of class \code{"integer"} ~~ }
+    \item{\code{k}:}{Object of class \code{"integer"} ~~ }
+    \item{\code{parNames}:}{Object of class \code{"character"} ~~ }
+    \item{\code{momNames}:}{Object of class \code{"character"} ~~ }
+    \item{\code{vcovOptions}:}{Object of class \code{"list"} ~~ }
+    \item{\code{centeredVcov}:}{Object of class \code{"logical"} ~~ }
+    \item{\code{varNames}:}{Object of class \code{"character"} ~~ }
+    \item{\code{isEndo}:}{Object of class \code{"logical"} ~~ }
+    \item{\code{omit}:}{Object of class \code{"integer"} ~~ }
+    \item{\code{survOptions}:}{Object of class \code{"list"} ~~ }
+    \item{\code{sSpec}:}{Object of class \code{"sSpec"} ~~ }
+    \item{\code{smooth}:}{Object of class \code{"logical"} ~~ }
+  }
+}
+\section{Extends}{Class \code{"\linkS4class{functionModel}"}, directly.
+Class \code{"\linkS4class{allNLModel}"}, by class "functionModel", distance 2.
+Class \code{"\linkS4class{momentModel}"}, by class "functionModel", distance 2.
+}
+\section{Methods}{
+No methods defined with class "causalModel" in the signature.
+}
+
+\examples{
+showClass("causalModel")
+}
+\keyword{classes}

Modified: pkg/causalGel/man/causalModel.Rd
===================================================================
--- pkg/causalGel/man/causalModel.Rd	2020-01-21 03:40:21 UTC (rev 164)
+++ pkg/causalGel/man/causalModel.Rd	2020-01-21 06:01:24 UTC (rev 165)
@@ -2,18 +2,16 @@
 
 \alias{causalModel}
 	
-\title{Constructor for \code{"causalGel"} classes}
+\title{Constructor for \code{"causalModel"} classes}
 
 \description{
-It builds the object of either class \code{"linearGmm"},
-\code{"nonlinearGmm"} or \code{"functionGmm"}. This is the first step
-before running any estimation algorithm.
+It builds the object of class \code{"functionModel"}, but with a
+specific function that depends on the type of causality. 
 }
 \usage{
 causalModel(g, balm, data,theta0=NULL,
             momType=c("ACE","ACT","ACC", "uncondBal","fixedMom"),
-            popMom = NULL, rhoFct=NULL,ACTmom=1L, 
-            gelType = c("EL", "ET", "EEL", "ETEL", "HD", "ETHD","REEL"))
+            popMom = NULL, ACTmom=1L) 
 }
 \arguments{
 
@@ -38,31 +36,13 @@
     can be used if those moments are available from a census, for
     example. When available, it greatly improves efficiency.}
 
-  \item{rhoFct}{An optional function that return \eqn{\rho(v)}. This is
-    for users who want a GEL model that is not built in the package. The
-    four arguments of the function must be \code{"gmat"}, the matrix of
-    moments, \code{"lambda"}, the vector of Lagrange multipliers,
-    \code{"derive"}, which specify the order of derivative to return, and
-    \code{k} a numeric scale factor required for time series and kernel
-    smoothed moments.}
-
   \item{ACTmom}{When \code{momType} is set to 'ACT', that integer
     indicates which treated group to use to balance the covariates.}
-  
-  
-  \item{gelType}{"EL" for empirical likelihood, "ET" for exponential tilting,
-    "EEL" for Euclidean empirical likelihood, "ETEL" for exponentially
-    tilted empirical likelihood of Schennach(2007), "HD" for Hellinger
-    Distance of Kitamura-Otsu-Evdokimov (2013), and "ETHD" for the
-    exponentially tilted Hellinger distance of Antoine-Dovonon
-    (2015). "REEL" is a restricted version of "EEL" in which the
-    probabilities are bounded below by zero. In that case, an analytical
-    Kuhn-Tucker method is used to find the solution.}
-  
+   
 }
 
 \value{
-'gmmModel' returns an object of one of the subclasses of \code{"gmmModels"}.
+It returns an object of class \code{"causalModel"}.
  }
 
 \examples{

Modified: pkg/causalGel/man/checkConv-methods.Rd
===================================================================
--- pkg/causalGel/man/checkConv-methods.Rd	2020-01-21 03:40:21 UTC (rev 164)
+++ pkg/causalGel/man/checkConv-methods.Rd	2020-01-21 06:01:24 UTC (rev 165)
@@ -29,7 +29,7 @@
 g <- re78~treat
            
 model <- causalModel(g, balm, nsw)
-fit <- modelFit(model)
+fit <- gelFit(model, gelType="EL")
 checkConv(fit)
 
 }

Added: pkg/causalGel/man/rcausalModel-class.Rd
===================================================================
--- pkg/causalGel/man/rcausalModel-class.Rd	                        (rev 0)
+++ pkg/causalGel/man/rcausalModel-class.Rd	2020-01-21 06:01:24 UTC (rev 165)
@@ -0,0 +1,48 @@
+\name{rcausalModel-class}
+\docType{class}
+\alias{rcausalModel-class}
+
+\title{Class \code{"rcausalModel"}}
+\description{
+  Restricted causality model class.
+}
+\section{Objects from the Class}{
+Objects can be created by calls of the form \code{new("rcausalModel", ...)}.
+It is however, recommended to use the \code{\link{restModel}} method.
+}
+\section{Slots}{
+  \describe{
+    \item{\code{R}:}{Object of class \code{"list"} ~~ }
+    \item{\code{cstSpec}:}{Object of class \code{"list"} ~~ }
+    \item{\code{X}:}{Object of class \code{"ANY"} ~~ }
+    \item{\code{fct}:}{Object of class \code{"function"} ~~ }
+    \item{\code{dfct}:}{Object of class \code{"functionORNULL"} ~~ }
+    \item{\code{vcov}:}{Object of class \code{"character"} ~~ }
+    \item{\code{theta0}:}{Object of class \code{"numeric"} ~~ }
+    \item{\code{n}:}{Object of class \code{"integer"} ~~ }
+    \item{\code{q}:}{Object of class \code{"integer"} ~~ }
+    \item{\code{k}:}{Object of class \code{"integer"} ~~ }
+    \item{\code{parNames}:}{Object of class \code{"character"} ~~ }
+    \item{\code{momNames}:}{Object of class \code{"character"} ~~ }
+    \item{\code{vcovOptions}:}{Object of class \code{"list"} ~~ }
+    \item{\code{centeredVcov}:}{Object of class \code{"logical"} ~~ }
+    \item{\code{varNames}:}{Object of class \code{"character"} ~~ }
+    \item{\code{isEndo}:}{Object of class \code{"logical"} ~~ }
+    \item{\code{omit}:}{Object of class \code{"integer"} ~~ }
+    \item{\code{survOptions}:}{Object of class \code{"list"} ~~ }
+    \item{\code{sSpec}:}{Object of class \code{"sSpec"} ~~ }
+    \item{\code{smooth}:}{Object of class \code{"logical"} ~~ }
+  }
+}
+\section{Extends}{
+Class \code{"\linkS4class{rfunctionModel}"}, directly.
+Class \code{"\linkS4class{functionModel}"}, by class "rfunctionModel", distance 2.
+Class \code{"\linkS4class{rmomentModel}"}, by class "rfunctionModel", distance 2.
+Class \code{"\linkS4class{allNLModel}"}, by class "rfunctionModel", distance 3.
+Class \code{"\linkS4class{momentModel}"}, by class "rfunctionModel", distance 3.
+}
+
+\examples{
+showClass("rcausalModel")
+}
+\keyword{classes}

Modified: pkg/causalGel/man/subsetting.Rd
===================================================================
--- pkg/causalGel/man/subsetting.Rd	2020-01-21 03:40:21 UTC (rev 164)
+++ pkg/causalGel/man/subsetting.Rd	2020-01-21 06:01:24 UTC (rev 165)
@@ -1,8 +1,11 @@
-\name{[-causalGel}
+\name{[-causalModel}
 \docType{methods}
-\alias{[,causalGel,missing,numericORlogical-method}
-\alias{[,causalGel,numeric,missing-method}
-\alias{[,causalGel,numeric,numericORlogical-method}
+\alias{[,causalModel,missing,numericORlogical-method}
+\alias{[,causalModel,numeric,missing-method}
+\alias{[,causalModel,numeric,numericORlogical-method}
+\alias{[,rcausalModel,missing,numericORlogical-method}
+\alias{[,rcausalModel,numeric,missing-method}
+\alias{[,rcausalModel,numeric,numericORlogical-method}
 \alias{[,causalGelfit,missing,numericORlogical-method}
 \alias{[,causalGelfit,numeric,missing-method}
 \alias{[,causalGelfit,numeric,numericORlogical-method}
@@ -17,18 +20,30 @@
 \section{Methods}{
 \describe{
 
-\item{\code{signature(x = "causalGel", i = "missing", j = "numericORlogical")}}{
+\item{\code{signature(x = "causalModel", i = "missing", j = "numericORlogical")}}{
   Subsets observations.
 }
   
-\item{\code{signature(x = "causalGel", i = "numeric", j = "missing")}}{
+\item{\code{signature(x = "causalModel", i = "numeric", j = "missing")}}{
   Selects balancing covatriates.
 }
 
-\item{\code{signature(x = "causalGel", i = "numeric", j = "numericORlogical")}}{
+\item{\code{signature(x = "causalModel", i = "numeric", j = "numericORlogical")}}{
   Selects balancing covariates and observations.
 }
 
+\item{\code{signature(x = "rcausalModel", i = "missing", j = "numericORlogical")}}{
+  Subsets observations for restricted models.
+}
+  
+\item{\code{signature(x = "rcausalModel", i = "numeric", j = "missing")}}{
+  Selects balancing covatriates for restricted models.
+}
+
+\item{\code{signature(x = "rcausalModel", i = "numeric", j = "numericORlogical")}}{
+  Selects balancing covariates and observations for restricted models.
+}
+
 \item{\code{signature(x = "causalGelfit", i = "missing", j = "numericORlogical")}}{
   Subsets observations and refit the model.
 }
@@ -54,7 +69,7 @@
 model <- causalModel(g, balm, nsw)           
 model[1:5, 1:500]
 
-fit <-  modelFit(model)
+fit <-  gelFit(model, gelType="EL")
 fit[1:5,1:500]
 
 }

Modified: pkg/causalGel/vignettes/causalGel.Rnw
===================================================================
--- pkg/causalGel/vignettes/causalGel.Rnw	2020-01-21 03:40:21 UTC (rev 164)
+++ pkg/causalGel/vignettes/causalGel.Rnw	2020-01-21 06:01:24 UTC (rev 165)
@@ -50,6 +50,7 @@
 \newcommand{\ATE}{ATE\xspace}
 \newcommand{\ACE}{ACE\xspace}
 \newcommand{\ACT}{ACT\xspace}
+\newcommand{\ACC}{ACC\xspace}
 \newcommand{\ACN}{ACN\xspace}
 \newcommand{\PFC}{PFC\xspace}
 \newcommand{\CH}{CH\xspace}
@@ -207,7 +208,7 @@
 
 \abstract{To be added}
 %\VignetteIndexEntry{Causal Inference with R}
-%\VignetteDepends{gmm4}
+%\VignetteDepends{momentfit}
 %\VignetteDepends{causalGel}
 %\VignetteKeywords{causal inference, empirical likelihood, GEL}
 %\VignettePackage{causalGel}
@@ -438,8 +439,8 @@
 nsw$re75 <- nsw$re75/1000
 @ 
 
-The model class, is ``causalGel'' which inherits directly from
-``functionGel'' class. The constructor is the causalModel()
+The model class, is ``causalModel'' which inherits directly from
+``functionModel'' class. The constructor is the causalModel()
 function. The arguments are:
 
 \begin{itemize}
@@ -521,9 +522,9 @@
 The following are three different models:
 
 <<>>=
-ace <- causalModel(g, balm, nsw, momType="ACE", gelType="EL")
-act <- causalModel(g, balm, nsw, momType="ACT", gelType="EL")
-aceRT <- causalModel(g, balm, nsw, momType="uncondBal", gelType="EL")
+ace <- causalModel(g, balm, nsw, momType="ACE")
+act <- causalModel(g, balm, nsw, momType="ACT")
+aceRT <- causalModel(g, balm, nsw, momType="uncondBal")
 @ 
 
 The third one is the \ACE assuming randomized assignments. A print
@@ -544,11 +545,11 @@
 
 <<>>=
 balm2 <- ~age*ed+black+hisp+re75+I(re75^2)
-ace2 <- causalModel(g, balm2, nsw, momType="ACE", gelType="EL")
+ace2 <- causalModel(g, balm2, nsw, momType="ACE")
 print(ace2, printBalCov=TRUE)
 @ 
 
-\subsection{The \textit{modelFit} method and the ``causalGelfit'' object}\label{sec:causalfit}
+\subsection{The \textit{gelFit} method and the ``causalGelfit'' object}\label{sec:causalfit}
 
 It simply calls the method for ``functionGel'', and creates a
 ``causalGelfit'' class object. The simpliest way to use it is to only
@@ -556,7 +557,7 @@
 $\lambdahat$ and model. 
 
 <<>>=
-fit1 <- modelFit(ace)
+fit1 <- gelFit(ace, gelType="EL") ## EL is the default
 print(fit1, model=FALSE, lambda=TRUE)
 @ 
 
@@ -628,7 +629,8 @@
   and the second being the observations. Consider the following 
   
 <<>>=
-ace <- causalModel(re78~treat, ~(age+black+ed)*(age+black+ed) + I(age^2) + I(ed^2),
+ace <- causalModel(re78~treat, 
+                   ~(age+black+ed)*(age+black+ed) + I(age^2) + I(ed^2),
                    data=nsw)
 print(ace, TRUE)
 @   
@@ -645,7 +647,7 @@
 print(ace[1:5], TRUE)
 @ 
 
-We can use a subset by add a second argument:
+We can use a subset of the sample by adding a second argument:
 
 <<>>=
 print(ace[,1:100], TRUE)
@@ -656,7 +658,7 @@
   the method for ``causalGelfit'' objects:
   
 <<>>=
-fit <- modelFit(ace)
+fit <- gelFit(ace)
 fit2 <- fit[,nsw$age<48]
 fit3 <- fit[1:3,1:500]
 @   
@@ -702,7 +704,8 @@
                  momType="uncondBal")
 @ 
 
-Similarly, the \ACE and \ACT can be computed as 
+Similarly, the \ACE, \ACT and \ACC can be computed as follows (The
+results are presented in Table \ref{t2}).
 
 <<>>=
 fit2 <- causalGEL(re78~treat, ~age+ed+black+hisp+re75, nsw, gelType="EL",
@@ -709,17 +712,57 @@
                   momType="ACE")
 fit3 <- causalGEL(re78~treat, ~age+ed+black+hisp+re75, nsw, gelType="EL",
                   momType="ACT")
+fit4 <- causalGEL(re78~treat, ~age+ed+black+hisp+re75, nsw, gelType="EL",
+                  momType="ACC")
 @ 
 
-The results are presented in Table \ref{t2}.
-
 <<echo=FALSE, results='asis'>>=
-texreg(list(fit1,fit2,fit3), digits=4, label="t2", 
-       custom.model.names=c("ACE(rand.)","ACE(non-random)", "ACT"),
+texreg(list(fit1,fit2,fit3,fit4), digits=4, label="t2", 
+       custom.model.names=c("ACE(rand.)","ACE(non-random)", "ACT", "ACC"),
        caption="Causal Effect for a Training Program", ci.force=TRUE,
        fontsize='footnotesize')
 @ 
 
+It is also possible to estimate restricted models, by passing
+restrictions to the arguments ``cstLHS'' and ``cstRHS''. There are two
+possible approaches. The first one is to define the restrictions in a
+vector of characters. In that case, ``cstRHS'' is set to its default
+value. For example, if we want to restrict the causal effect
+coefficient to be equal to 1, we proceed as:
+
+<<>>=
+causalGEL(re78~treat, ~age+ed+black+hisp+re75, nsw, gelType="EL",
+          momType="uncondBal", cstLHS="causalEffect=1")
+@ 
+
+If we want the above restriction plus the probability of being in the
+treatment group to be equal 0.5, we proceed this way. Notice that the
+restricted model only has one coefficient. To avoid complains coming
+from optim(), which warns you that Nelder-Mead is not reliable in
+one-dimensional optimization problems, we set the method to ``Brent''
+using the ``tControl'' argument:
+
+<<>>=
+causalGEL(re78~treat, ~age+ed+black+hisp+re75, nsw, gelType="EL",
+          momType="uncondBal", cstLHS=c("causalEffect=1", "probTreatment=0.5"),
+          tControl=list(method="Brent", lower=0, upper=10))
+@ 
+
+The problem with the above approach is that we need to know the names
+of the coefficients before calling causalGel(). For equallity
+constraints, we can instead set ``cstLHS'' to the coefficient
+positions, and ``cstRHS'' to their restricted values. The above two
+restricted models can therefore be obtained as follows:
+
+<<>>=
+causalGEL(re78~treat, ~age+ed+black+hisp+re75, nsw, gelType="EL",
+          momType="uncondBal", cstLHS=2, cstRHS=1)@theta
+causalGEL(re78~treat, ~age+ed+black+hisp+re75, nsw, gelType="EL",
+          momType="uncondBal", cstLHS=2:3, cstRHS=c(1,.5),
+          tControl=list(method="Brent", lower=0, upper=10))@theta
+@ 
+
+
 \bibliography{causal}
 
 \appendix

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

[TRUNCATED]

To get the complete diff run:
    svnlook diff /svnroot/gmm -r 165


More information about the Gmm-commits mailing list