[Gmm-commits] r164 - in pkg: . causalGel causalGel/R causalGel/man gmm4/R gmm4/man gmm4/vignettes momentfit momentfit/R momentfit/data momentfit/man momentfit/src momentfit/vignettes
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Tue Jan 21 04:40:22 CET 2020
Author: chaussep
Date: 2020-01-21 04:40:21 +0100 (Tue, 21 Jan 2020)
New Revision: 164
Added:
pkg/momentfit/
pkg/momentfit/DESCRIPTION
pkg/momentfit/NAMESPACE
pkg/momentfit/NEWS
pkg/momentfit/R/
pkg/momentfit/R/allClasses.R
pkg/momentfit/R/gel.R
pkg/momentfit/R/gel4.R
pkg/momentfit/R/gelfit-methods.R
pkg/momentfit/R/gmm4.R
pkg/momentfit/R/gmmfit-methods.R
pkg/momentfit/R/hypothesisTest-methods.R
pkg/momentfit/R/momentData.R
pkg/momentfit/R/momentModel-methods.R
pkg/momentfit/R/momentModel.R
pkg/momentfit/R/momentWeights-methods.R
pkg/momentfit/R/rModel-methods.R
pkg/momentfit/R/rsysMomentModel-methods.R
pkg/momentfit/R/sgmmfit-methods.R
pkg/momentfit/R/specTest-methods.R
pkg/momentfit/R/summary-methods.R
pkg/momentfit/R/sysMomentModel-methods.R
pkg/momentfit/R/sysMomentModel.R
pkg/momentfit/R/validity.R
pkg/momentfit/data/
pkg/momentfit/data/CigarettesSW.rda
pkg/momentfit/data/ConsumptionG.rda
pkg/momentfit/data/Griliches.rda
pkg/momentfit/data/HealthRWM.rda
pkg/momentfit/data/Klein.rda
pkg/momentfit/data/LabourCR.rda
pkg/momentfit/data/ManufactCost.rda
pkg/momentfit/data/Mroz.rda
pkg/momentfit/data/simData.rda
pkg/momentfit/man/
pkg/momentfit/man/CigarettesSW.Rd
pkg/momentfit/man/ConsumptionG.Rd
pkg/momentfit/man/DWH-methods.Rd
pkg/momentfit/man/Dresiduals-methods.Rd
pkg/momentfit/man/Griliches.Rd
pkg/momentfit/man/HealthRWM.Rd
pkg/momentfit/man/Klein.Rd
pkg/momentfit/man/LabourCR.Rd
pkg/momentfit/man/ManufactCost.Rd
pkg/momentfit/man/Mroz.Rd
pkg/momentfit/man/ThreeSLS-methods.Rd
pkg/momentfit/man/allNLModel-class.Rd
pkg/momentfit/man/bread-methods.Rd
pkg/momentfit/man/coef-methods.Rd
pkg/momentfit/man/confint-class.Rd
pkg/momentfit/man/confint-methods.Rd
pkg/momentfit/man/estfun-methods.Rd
pkg/momentfit/man/evalDMoment-methods.Rd
pkg/momentfit/man/evalGel-methods.Rd
pkg/momentfit/man/evalGelObj-methods.Rd
pkg/momentfit/man/evalGmm-methods.Rd
pkg/momentfit/man/evalGmmObj-methods.Rd
pkg/momentfit/man/evalMoment-methods.Rd
pkg/momentfit/man/evalWeights-methods.Rd
pkg/momentfit/man/formulaModel-class.Rd
pkg/momentfit/man/functionModel-class.Rd
pkg/momentfit/man/gel4.Rd
pkg/momentfit/man/gelFit-methods.Rd
pkg/momentfit/man/gelfit-class.Rd
pkg/momentfit/man/getImpProb-methods.Rd
pkg/momentfit/man/getRestrict-methods.Rd
pkg/momentfit/man/gmm4.Rd
pkg/momentfit/man/gmmFit-methods.Rd
pkg/momentfit/man/gmmfit-class.Rd
pkg/momentfit/man/hypothesisTest-class.Rd
pkg/momentfit/man/hypothesisTest-methods.Rd
pkg/momentfit/man/kernapply-methods.Rd
pkg/momentfit/man/lambdaAlgo.Rd
pkg/momentfit/man/linearModel-class.Rd
pkg/momentfit/man/mconfint-class.Rd
pkg/momentfit/man/meatGmm-methods.Rd
pkg/momentfit/man/merge-methods.Rd
pkg/momentfit/man/model.matrix-methods.Rd
pkg/momentfit/man/modelDims-methods.Rd
pkg/momentfit/man/modelResponse-methods.Rd
pkg/momentfit/man/momFct-methods.Rd
pkg/momentfit/man/momentModel-class.Rd
pkg/momentfit/man/momentModel.Rd
pkg/momentfit/man/momentStrength-methods.Rd
pkg/momentfit/man/momentWeights-class.Rd
pkg/momentfit/man/nonlinearModel-class.Rd
pkg/momentfit/man/plot-methods.Rd
pkg/momentfit/man/print-methods.Rd
pkg/momentfit/man/printRestrict-methods.Rd
pkg/momentfit/man/quadra-methods.Rd
pkg/momentfit/man/regModel-class.Rd
pkg/momentfit/man/residuals-methods.Rd
pkg/momentfit/man/restModel-methods.Rd
pkg/momentfit/man/rformulaModel-class.Rd
pkg/momentfit/man/rfunctionModel-class.Rd
pkg/momentfit/man/rhoFct.Rd
pkg/momentfit/man/rlinearModel-class.Rd
pkg/momentfit/man/rmomentModel-class.Rd
pkg/momentfit/man/rnonlinearModel-class.Rd
pkg/momentfit/man/rslinearModel-class.Rd
pkg/momentfit/man/rsnonlinearModel-class.Rd
pkg/momentfit/man/rsysModel-class.Rd
pkg/momentfit/man/sSpec-class.Rd
pkg/momentfit/man/sgmmfit-class.Rd
pkg/momentfit/man/show-methods.Rd
pkg/momentfit/man/simData.Rd
pkg/momentfit/man/slinearModel-class.Rd
pkg/momentfit/man/snonlinearModel-class.Rd
pkg/momentfit/man/solveGel-methods.Rd
pkg/momentfit/man/solveGmm-methods.Rd
pkg/momentfit/man/specTest-class.Rd
pkg/momentfit/man/specTest-methods.Rd
pkg/momentfit/man/stsls-class.Rd
pkg/momentfit/man/subsetting.Rd
pkg/momentfit/man/summary-methods.Rd
pkg/momentfit/man/summaryGel-class.Rd
pkg/momentfit/man/summaryGmm-class.Rd
pkg/momentfit/man/summarySysGmm-class.Rd
pkg/momentfit/man/sysModel-class.Rd
pkg/momentfit/man/sysMomentModel.Rd
pkg/momentfit/man/sysMomentWeights-class.Rd
pkg/momentfit/man/systemGmm.Rd
pkg/momentfit/man/tsls-class.Rd
pkg/momentfit/man/tsls-methods.Rd
pkg/momentfit/man/update-methods.Rd
pkg/momentfit/man/vcov-methods.Rd
pkg/momentfit/man/vcovHAC-methods.Rd
pkg/momentfit/src/
pkg/momentfit/src/Makevars
pkg/momentfit/src/lambda_met.f
pkg/momentfit/src/momentfit.h
pkg/momentfit/src/src.c
pkg/momentfit/vignettes/
pkg/momentfit/vignettes/empir.bib
pkg/momentfit/vignettes/gelS4.Rnw
pkg/momentfit/vignettes/gelS4.pdf
pkg/momentfit/vignettes/gmmS4.Rnw
pkg/momentfit/vignettes/gmmS4.pdf
Modified:
pkg/causalGel/DESCRIPTION
pkg/causalGel/NAMESPACE
pkg/causalGel/R/allClasses.R
pkg/causalGel/R/causalGel.R
pkg/causalGel/R/causalfitMethods.R
pkg/causalGel/man/causalGEL.Rd
pkg/gmm4/R/allClasses.R
pkg/gmm4/R/gelfit-methods.R
pkg/gmm4/R/gmmData.R
pkg/gmm4/R/gmmModel.R
pkg/gmm4/R/gmmModels-methods.R
pkg/gmm4/R/rGelModel-methods.R
pkg/gmm4/R/rGmmModel-methods.R
pkg/gmm4/R/validity.R
pkg/gmm4/man/evalDMoment-methods.Rd
pkg/gmm4/man/modelDims-methods.Rd
pkg/gmm4/vignettes/gelS4.pdf
pkg/gmm4/vignettes/gmmS4.pdf
Log:
convert gmm4 into momenfit. gmm4 will soon be removed
Modified: pkg/causalGel/DESCRIPTION
===================================================================
--- pkg/causalGel/DESCRIPTION 2019-12-06 22:44:22 UTC (rev 163)
+++ pkg/causalGel/DESCRIPTION 2020-01-21 03:40:21 UTC (rev 164)
@@ -9,7 +9,8 @@
Depends: R (>= 3.0.0), gmm4 (>= 0.2.0)
Imports: stats, methods
Suggests: lmtest, knitr, texreg
-Collate: 'allClasses.R' 'causalMethods.R' 'causalGel.R' 'causalfitMethods.R'
+Collate: 'allClasses.R' 'causalMethods.R' 'rcausalMethods.R' 'causalGel.R'
+ 'causalfitMethods.R'
License: GPL (>= 2)
NeedsCompilation: no
VignetteBuilder: knitr
Modified: pkg/causalGel/NAMESPACE
===================================================================
--- pkg/causalGel/NAMESPACE 2019-12-06 22:44:22 UTC (rev 163)
+++ pkg/causalGel/NAMESPACE 2020-01-21 03:40:21 UTC (rev 164)
@@ -10,7 +10,7 @@
### S4 Methods and Classes
exportClasses()
-exportClasses("causalData", "causalGel", "causalGelfit")
+exportClasses("causalData", "causalGel", "causalGelfit", "rcausalGel")
exportMethods("causalMomFct", "checkConv")
Modified: pkg/causalGel/R/allClasses.R
===================================================================
--- pkg/causalGel/R/allClasses.R 2019-12-06 22:44:22 UTC (rev 163)
+++ pkg/causalGel/R/allClasses.R 2020-01-21 03:40:21 UTC (rev 164)
@@ -6,6 +6,8 @@
setClass("causalGel", contains="functionGel")
+setClass("rcausalGel", contains="rfunctionGel")
+
setClass("causalData", representation(momType="character",
balCov="character",
balMom="numericORNULL",
@@ -18,3 +20,13 @@
## converters
+setAs("rcausalGel", "rgmmModels",
+ function(from) {
+ as(as(from, "rgelModels"), "rgmmModels")})
+
+setAs("rcausalGel", "causalGel",
+ function(from) {
+ obj <- as(from, "gelModels")
+ new("causalGel", obj)})
+
+
Modified: pkg/causalGel/R/causalGel.R
===================================================================
--- pkg/causalGel/R/causalGel.R 2019-12-06 22:44:22 UTC (rev 163)
+++ pkg/causalGel/R/causalGel.R 2020-01-21 03:40:21 UTC (rev 164)
@@ -72,7 +72,7 @@
popMom = NULL, rhoFct=NULL,ACTmom=1L,
gelType = c("EL", "ET", "EEL", "ETEL", "HD", "ETHD","REEL"),
initTheta = c("gmm","theta0"), getVcov=FALSE,
- lambda0=NULL,
+ lambda0=NULL, cstLHS=NULL, cstRHS=NULL,
lamSlv=NULL, coefSlv= c("optim","nlminb","constrOptim"),
lControl=list(), tControl=list())
{
@@ -96,6 +96,27 @@
} else {
theta0 <- NULL
}
+ if (!is.null(cstLHS)) {
+ if (is.numeric(cstLHS))
+ {
+ parn <- model at parNames
+ if (is.null(cstRHS))
+ {
+ cstLHS <- paste(parn[cstLHS], "=0", sep="")
+ } else {
+ if (!is.numeric(cstRHS))
+ stop("cstRHS is either NULL or numeric")
+ if (length(cstRHS)!=length(cstLHS))
+ stop("cstRHS and csrLHS must have the can length")
+ cstLHS <- paste(parn[cstLHS], "=", cstRHS, sep="")
+ cstRHS <- NULL
+ }
+ }
+ model <- restModel(model, cstLHS, cstRHS)
+ spec <- modelDims(model)
+ 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)
Modified: pkg/causalGel/R/causalfitMethods.R
===================================================================
--- pkg/causalGel/R/causalfitMethods.R 2019-12-06 22:44:22 UTC (rev 163)
+++ pkg/causalGel/R/causalfitMethods.R 2020-01-21 03:40:21 UTC (rev 164)
@@ -103,12 +103,19 @@
## vcov
setMethod("vcov", "causalGelfit",
- function(object, robToMiss = TRUE, withImpProb=FALSE, tol=1e-10) {
+ function(object, withImpProb=FALSE, tol=1e-10,
+ robToMiss = TRUE) {
if (!robToMiss)
{
- allV <- getMethod("vcov","gelfit")(object, withImpProb, tol)
+ allV <- getMethod("vcov","gelfit")(object, withImpProb, tol,
+ FALSE)
return(allV)
}
+ if (inherits(object at model, "rcausalGel"))
+ {
+ allV <- getMethod("vcov","gelfit")(object, withImpProb, tol, TRUE)
+ return(allV)
+ }
res <- .psiGam(object)
k <- res$k
q <- res$q
Modified: pkg/causalGel/man/causalGEL.Rd
===================================================================
--- pkg/causalGel/man/causalGEL.Rd 2019-12-06 22:44:22 UTC (rev 163)
+++ pkg/causalGel/man/causalGEL.Rd 2020-01-21 03:40:21 UTC (rev 164)
@@ -15,7 +15,7 @@
popMom = NULL, rhoFct=NULL,ACTmom=1L,
gelType = c("EL", "ET", "EEL", "ETEL", "HD", "ETHD","REEL"),
initTheta = c("gmm","theta0"), getVcov=FALSE,
- lambda0=NULL,
+ lambda0=NULL, cstLHS=NULL, cstRHS=NULL,
lamSlv=NULL, coefSlv= c("optim","nlminb","constrOptim"),
lControl=list(), tControl=list())
}
@@ -70,6 +70,12 @@
\item{lambda0}{Manual starting values for the Lagrange
multiplier. By default, it is a vector of zeros.}
+ \item{cstLHS}{The left hand side of the constraints to impose on the
+ coefficients. See \code{\link{restModel}} for more details.}
+
+ \item{cstRHS}{The right hand side of the constraints to impose on the
+ coefficients. See \code{\link{restModel}} for more details.}
+
\item{getVcov}{Should the method computes the covariance matrices of the
coefficients and Lagrange multipliers.}
Modified: pkg/gmm4/R/allClasses.R
===================================================================
--- pkg/gmm4/R/allClasses.R 2019-12-06 22:44:22 UTC (rev 163)
+++ pkg/gmm4/R/allClasses.R 2020-01-21 03:40:21 UTC (rev 164)
@@ -197,6 +197,7 @@
setAs("rgelModels", "rgmmModels",
function(from) {
+
obj <- as(from, "gmmModels")
cls <- strsplit(class(from), "Gel")[[1]][1]
cls <- paste(cls, "Gmm", sep="")
Modified: pkg/gmm4/R/gelfit-methods.R
===================================================================
--- pkg/gmm4/R/gelfit-methods.R 2019-12-06 22:44:22 UTC (rev 163)
+++ pkg/gmm4/R/gelfit-methods.R 2020-01-21 03:40:21 UTC (rev 164)
@@ -22,13 +22,13 @@
test0 <- test0[1]
} else {
test0 <- 0
- }
+ }
f <- function(delta, pti, obj, which, type, test0, level)
{
b <- coef(obj)[which]
pti <- b*(1-delta) + pti*delta
R <- paste(names(b), "=", pti, sep="")
- if (obj at call[[1]] == "gel4")
+ if (obj at call[[1]] != "modelFit")
{
fit <- suppressWarnings(update(obj, cstLHS=R))
} else {
@@ -663,7 +663,9 @@
if (length(eta) != (spec$k+spec$q))
stop("eta must include theta and lambda")
object at theta <- head(eta, spec$k)
+ names(object at theta) <- spec$parNames
object at lambda <- tail(eta, spec$q)
+ names(object at lambda) <- spec$momNames
pt <- getImpProb(object, FALSE, FALSE)$pt*spec$n
gt <- evalMoment(object at model, object at theta)*pt
Gtl <- evalDMoment(object at model, object at theta, pt, object at lambda)
Modified: pkg/gmm4/R/gmmData.R
===================================================================
--- pkg/gmm4/R/gmmData.R 2019-12-06 22:44:22 UTC (rev 163)
+++ pkg/gmm4/R/gmmData.R 2020-01-21 03:40:21 UTC (rev 164)
@@ -244,9 +244,18 @@
}
.fGmmData <- function(g, x, theta0, survOptions=list(), vcovOptions=list(),
- na.action="na.omit")
+ na.action="na.omit", grad=NULL)
{
mom <- try(g(theta0, x))
+ if (!is.null(grad))
+ {
+ dmom <- try(grad(theta0, x))
+ if (inherits(dmom, "try-error"))
+ {
+ warning("grad could not be evaluated at the starting theta. Changed to NULL")
+ grad <- NULL
+ }
+ }
k <- length(theta0)
if (is.null(names(theta0)))
{
@@ -280,7 +289,8 @@
}
list(q=q,n=n,k=k, momNames=momNames, parNames=parNames,
varNames=character(), isEndo=logical(), omit=integer(),
- vcovOptions=vcovOptions, survOptions=survOptions, theta0=theta0)
+ vcovOptions=vcovOptions, survOptions=survOptions, theta0=theta0,
+ dfct=grad)
}
.slGmmData <- function(g,h,data, survOptions=list(), vcovOptions=list(),
Modified: pkg/gmm4/R/gmmModel.R
===================================================================
--- pkg/gmm4/R/gmmModel.R 2019-12-06 22:44:22 UTC (rev 163)
+++ pkg/gmm4/R/gmmModel.R 2020-01-21 03:40:21 UTC (rev 164)
@@ -137,8 +137,9 @@
survOptions=model$survOptions)
}
} else if (is.function(g)) {
- model <- .fGmmData(g, x, theta0, survOptions, vcovOptions, na.action)
- gmodel <- new("functionGmm", X=x, fct=g,
+ model <- .fGmmData(g, x, theta0, survOptions, vcovOptions, na.action,
+ grad)
+ gmodel <- new("functionGmm", X=x, fct=g, dfct=model$dfct,
theta0=model$theta0, vcov=vcov,vcovOptions=model$vcovOptions,
centeredVcov = centeredVcov, k=model$k, q=model$q,
n=model$n, parNames=model$parNames,
Modified: pkg/gmm4/R/gmmModels-methods.R
===================================================================
--- pkg/gmm4/R/gmmModels-methods.R 2019-12-06 22:44:22 UTC (rev 163)
+++ pkg/gmm4/R/gmmModels-methods.R 2020-01-21 03:40:21 UTC (rev 164)
@@ -45,7 +45,16 @@
setMethod("coef", "gmmModels",
function(object, theta) {
- names(theta) <- object at parNames
+ if (length(theta) != length(object at parNames))
+ stop("Wrong number of coefficients")
+ if (!is.null(names(theta)))
+ {
+ if (!all(names(theta)%in%object at parNames))
+ stop("theta has wrong names")
+ theta <- theta[match(object at parNames, names(theta))]
+ } else {
+ names(theta) <- object at parNames
+ }
theta})
################## model.matrix and modelResponse #################
@@ -195,6 +204,7 @@
setMethod("Dresiduals", signature("nonlinearGmm"),
function(object, theta) {
+ theta <- coef(object, theta)
res <- modelDims(object)
nt <- names(theta)
nt0 <- names(res$theta0)
@@ -334,6 +344,7 @@
setMethod("evalDMoment", signature("formulaGmm"),
function(object, theta, impProb=NULL, lambda=NULL)
{
+ theta <- coef(object, theta)
spec <- modelDims(object)
nt <- names(theta)
nt0 <- names(spec$theta0)
Modified: pkg/gmm4/R/rGelModel-methods.R
===================================================================
--- pkg/gmm4/R/rGelModel-methods.R 2019-12-06 22:44:22 UTC (rev 163)
+++ pkg/gmm4/R/rGelModel-methods.R 2020-01-21 03:40:21 UTC (rev 164)
@@ -1,7 +1,8 @@
+
setMethod("restModel", signature("linearGel"),
function(object, R, rhs=NULL)
{
- mod <- callNextMethod()
+ mod <- restModel(as(object, "gmmModels"), R, rhs)
gmmToGel(mod, object at gelType$name, object at gelType$rhoFct)
})
@@ -8,7 +9,7 @@
setMethod("restModel", signature("nonlinearGel"),
function(object, R, rhs=NULL)
{
- mod <- callNextMethod()
+ mod <- restModel(as(object, "gmmModels"), R, rhs)
gmmToGel(mod, object at gelType$name, object at gelType$rhoFct)
})
@@ -15,7 +16,7 @@
setMethod("restModel", signature("formulaGel"),
function(object, R, rhs=NULL)
{
- mod <- callNextMethod()
+ mod <- restModel(as(object, "gmmModels"), R, rhs)
gmmToGel(mod, object at gelType$name, object at gelType$rhoFct)
})
@@ -22,7 +23,7 @@
setMethod("restModel", signature("functionGel"),
function(object, R, rhs=NULL)
{
- mod <- callNextMethod()
+ mod <- restModel(as(object, "gmmModels"), R, rhs)
gmmToGel(mod, object at gelType$name, object at gelType$rhoFct)
})
@@ -29,36 +30,31 @@
## printRestrict
setMethod("printRestrict", signature("rgelModels"),
- function(object)
- {
- cl <- strsplit(class(object)[1],"Gel")[[1]][1]
- cl <- paste(cl, "Gmm", sep="")
- getMethod("printRestrict", cl)(object)
- })
+ function(object) printRestrict(as(object, "rgmmModels")))
-
## print
setMethod("print", "rgelModels",
function(x)
{
- cl <- class(x)[1]
- getMethod("print", "gelModels")(x)
+ print(as(x, "gelModels"))
printRestrict(x)
})
## modelDims
+setMethod("modelDims", "rlinearGel",
+ function(object) modelDims(as(object, "rgmmModels")))
-setMethod("modelDims", "rgelModels",
- function(object)
- {
- cl <- strsplit(class(object)[1],"Gel")[[1]][1]
- cl <- paste(cl, "Gmm", sep="")
- getMethod("modelDims", cl)(object)
-
- })
+setMethod("modelDims", "rnonlinearGel",
+ function(object) modelDims(as(object, "rgmmModels")))
+setMethod("modelDims", "rfunctionGel",
+ function(object) modelDims(as(object, "rgmmModels")))
+
+setMethod("modelDims", "rformulaGel",
+ function(object) modelDims(as(object, "rgmmModels")))
+
## model.matrix and modelResponse
@@ -66,14 +62,11 @@
function(object, type=c("regressors","instruments"))
{
type <- match.arg(type)
- getMethod("model.matrix", "rlinearGmm")(object, type)
+ model.matrix(as(object, "rgmmModels"), type)
})
setMethod("modelResponse", "rlinearGel",
- function(object)
- {
- getMethod("modelResponse", "rlinearGmm")(object)
- })
+ function(object) modelResponse(as(object, "rgmmModels")))
## getRestrict
@@ -80,29 +73,17 @@
setMethod("getRestrict", "rgelModels",
- function(object, theta)
- {
- cl <- strsplit(class(object)[1],"Gel")[[1]][1]
- cl <- paste(cl, "Gmm", sep="")
- getMethod("getRestrict", cl)(object, theta)
-
- })
+ function(object, theta) getRestrict(as(object,"rgmmModels"), theta))
+
setMethod("getRestrict", "gelModels",
- function(object, theta, R, rhs=NULL) {
- getMethod("getRestrict", "gmmModels")(object)
- })
+ function(object, theta, R, rhs=NULL)
+ getRestrict(as(object,"gmmModels"), theta, R, rhs))
-
## coef
setMethod("coef", "rgelModels",
- function(object, theta)
- {
- cl <- strsplit(class(object)[1],"Gel")[[1]][1]
- cl <- paste(cl, "Gmm", sep="")
- getMethod("coef", cl)(object, theta)
- })
+ function(object, theta) coef(as(object, "rgmmModels"), theta))
## subset
@@ -112,7 +93,20 @@
callNextMethod()
})
+## evalDMoment
+setMethod("evalDMoment", "rgelModels",
+ function(object, theta, impProb=NULL, lambda=NULL)
+ {
+ spec <- modelDims(object)
+ if (object at vcov != "HAC")
+ {
+ G <- evalDMoment(as(object, "rgmmModels"), theta, impProb, lambda)
+ } else {
+ G <- getMethod("evalDMoment","gelModels")(object, theta, impProb, lambda)
+ }
+ G})
+
## modelFit
setMethod("modelFit", signature("rlinearGel"), valueClass="gelfit",
Modified: pkg/gmm4/R/rGmmModel-methods.R
===================================================================
--- pkg/gmm4/R/rGmmModel-methods.R 2019-12-06 22:44:22 UTC (rev 163)
+++ pkg/gmm4/R/rGmmModel-methods.R 2020-01-21 03:40:21 UTC (rev 164)
@@ -172,19 +172,21 @@
else
lhs[[i]] <- NULL
for (r in R)
- {
- rhs[[i]] <- gsub(as.character(r[2]), paste("(", as.character(r[3]),
- ")", sep=""), rhs[[i]])
- if (!is.null(lhs[[i]]))
- lhs[[i]] <- gsub(as.character(r[2]),
- paste("(", as.character(r[3]),
- ")", sep=""), lhs[[i]])
- }
+ {
+ rhs[[i]] <- gsub(as.character(r[2]), paste("(", as.character(r[3]),
+ ")", sep=""), rhs[[i]])
+ if (!is.null(lhs[[i]]))
+ lhs[[i]] <- gsub(as.character(r[2]),
+ paste("(", as.character(r[3]),
+ ")", sep=""), lhs[[i]])
+ }
rhs[[i]] <- parse(text=rhs[[i]])
lhs[[i]] <- parse(text=lhs[[i]])
}
k <- object at k-length(R)
parNames <- object at parNames[!(object at parNames %in% rest)]
+ if (length(parNames)!=k)
+ stop("Failed to create the restricted model")
theta0 <- object at theta0[!(object at parNames %in% rest)]
list(rhs=rhs, lhs=lhs, parNames=parNames, theta0=theta0, k=k)
}
@@ -257,9 +259,42 @@
res <- object at cstSpec
list(k = res$k, q = object at q, n = object at n, parNames = res$newParNames,
momNames = object at momNames, theta0 = res$theta0,
- fct = res$fct, dfct = res$dfct)
+ fct = object at fct, dfct = object at dfct)
})
+### evalDMoment
+
+setMethod("evalDMoment", signature("rfunctionGmm"),
+ function(object, theta, impProb=NULL, lambda=NULL)
+ {
+ G <- evalDMoment(as(object, "functionGmm"),
+ coef(object, theta), impProb, lambda)
+ ntheta <- modelDims(object)$parNames
+ G <- G[,colnames(G) %in% ntheta, drop=FALSE]
+ G
+ })
+
+setMethod("evalDMoment", signature("rformulaGmm"),
+ function(object, theta, impProb=NULL, lambda=NULL)
+ {
+ G <- evalDMoment(as(object, "formulaGmm"),
+ coef(object, theta), impProb, lambda)
+ ntheta <- modelDims(object)$parNames
+ G <- G[,colnames(G) %in% ntheta, drop=FALSE]
+ G
+ })
+
+setMethod("evalDMoment", signature("rnonlinearGmm"),
+ function(object, theta, impProb=NULL, lambda=NULL)
+ {
+ G <- evalDMoment(as(object, "nonlinearGmm"),
+ coef(object, theta), impProb, lambda)
+ ntheta <- modelDims(object)$parNames
+ G <- G[,colnames(G) %in% ntheta, drop=FALSE]
+ G
+ })
+
+
### print restricted equation
.printRFct <- function(object)
@@ -649,7 +684,6 @@
setMethod("coef", "rnonlinearGmm",
function(object, theta)
{
-
spec <- modelDims(object)
if (length(theta)>0)
{
Modified: pkg/gmm4/R/validity.R
===================================================================
--- pkg/gmm4/R/validity.R 2019-12-06 22:44:22 UTC (rev 163)
+++ pkg/gmm4/R/validity.R 2020-01-21 03:40:21 UTC (rev 164)
@@ -282,6 +282,7 @@
.checkfGmm <- function(object)
{
+
mom <- try(object at fct(object at theta0, object at X))
k <- length(object at theta0)
error <- character()
Modified: pkg/gmm4/man/evalDMoment-methods.Rd
===================================================================
--- pkg/gmm4/man/evalDMoment-methods.Rd 2019-12-06 22:44:22 UTC (rev 163)
+++ pkg/gmm4/man/evalDMoment-methods.Rd 2020-01-21 03:40:21 UTC (rev 164)
@@ -3,8 +3,12 @@
\alias{evalDMoment}
\alias{evalDMoment-methods}
\alias{evalDMoment,functionGmm-method}
+\alias{evalDMoment,rfunctionGmm-method}
\alias{evalDMoment,gelModels-method}
+\alias{evalDMoment,rgelModels-method}
\alias{evalDMoment,formulaGmm-method}
+\alias{evalDMoment,rformulaGmm-method}
+\alias{evalDMoment,rnonlinearGmm-method}
\alias{evalDMoment,sysGmmModels-method}
\alias{evalDMoment,rslinearGmm-method}
\alias{evalDMoment,regGmm-method}
@@ -18,9 +22,18 @@
\S4method{evalDMoment}{functionGmm}(object, theta, impProb=NULL,
lambda=NULL)
+\S4method{evalDMoment}{rfunctionGmm}(object, theta, impProb=NULL,
+lambda=NULL)
+
+\S4method{evalDMoment}{rnonlinearGmm}(object, theta, impProb=NULL,
+lambda=NULL)
+
\S4method{evalDMoment}{formulaGmm}(object, theta, impProb=NULL,
lambda=NULL)
+\S4method{evalDMoment}{rformulaGmm}(object, theta, impProb=NULL,
+lambda=NULL)
+
\S4method{evalDMoment}{regGmm}(object, theta, impProb=NULL,
lambda=NULL)
@@ -30,6 +43,9 @@
\S4method{evalDMoment}{gelModels}(object, theta, impProb=NULL,
lambda=NULL)
+
+\S4method{evalDMoment}{rgelModels}(object, theta, impProb=NULL,
+lambda=NULL)
}
\arguments{
@@ -49,12 +65,25 @@
\item{\code{signature(object = "functionGmm")}}{
}
+\item{\code{signature(object = "rfunctionGmm")}}{
+The theta vector must match the number of coefficients in the restricted
+model.
+}
+
\item{\code{signature(object = "gelModels")}}{
}
+\item{\code{signature(object = "rgelModels")}}{
+}
+
\item{\code{signature(object = "formulaGmm")}}{
}
+\item{\code{signature(object = "rformulaGmm")}}{
+The theta vector must match the number of coefficients in the restricted
+model.
+}
+
\item{\code{signature(object = "regGmm")}}{
}
Modified: pkg/gmm4/man/modelDims-methods.Rd
===================================================================
--- pkg/gmm4/man/modelDims-methods.Rd 2019-12-06 22:44:22 UTC (rev 163)
+++ pkg/gmm4/man/modelDims-methods.Rd 2020-01-21 03:40:21 UTC (rev 164)
@@ -15,6 +15,10 @@
\alias{modelDims,rlinearGmm-method}
\alias{modelDims,rfunctionGmm-method}
\alias{modelDims,rnonlinearGmm-method}
+\alias{modelDims,rformulaGel-method}
+\alias{modelDims,rlinearGel-method}
+\alias{modelDims,rfunctionGel-method}
+\alias{modelDims,rnonlinearGel-method}
\title{Methods for Function \code{modelDims}}
\description{
It extracts important information from the model. It is mostly used by
@@ -30,6 +34,18 @@
\item{\code{signature(object = "rgelModels")}}{
}
+\item{\code{signature(object = "rlinearGel")}}{
+}
+
+\item{\code{signature(object = "rnonlinearGel")}}{
+}
+
+\item{\code{signature(object = "rfunctionGel")}}{
+}
+
+\item{\code{signature(object = "rformulaGel")}}{
+}
+
\item{\code{signature(object = "rnonlinearGmm")}}{
}
Modified: pkg/gmm4/vignettes/gelS4.pdf
===================================================================
(Binary files differ)
Modified: pkg/gmm4/vignettes/gmmS4.pdf
===================================================================
(Binary files differ)
Added: pkg/momentfit/DESCRIPTION
===================================================================
--- pkg/momentfit/DESCRIPTION (rev 0)
+++ pkg/momentfit/DESCRIPTION 2020-01-21 03:40:21 UTC (rev 164)
@@ -0,0 +1,19 @@
+Package: momentfit
+Version: 0.1-0
+Date: 2020-01-20
+Title: Methods of Moments
+Author: Pierre Chausse <pchausse at uwaterloo.ca>
+Maintainer: Pierre Chausse <pchausse at uwaterloo.ca>
+Description: Various methods for estimating models based on moment conditions. The methods include the Generalized method of moments (Hansen 1982; <doi:10.2307/1912775>) and the Generalized Empirical Likelihood (Smith 1997; <doi:10.1111/j.0013-0133.1997.174.x>, Kitamura 1997; <doi:10.1214/aos/1069362388>, Newey and Smith 2004; <doi:10.1111/j.1468-0262.2004.00482.x>, and Anatolyev 2005 <doi:10.1111/j.1468-0262.2005.00601.x>). It provides tools for estimating single equations and system of equations. It is in a very early stage and suggestions are welcome. See the vignette for more details.
+Depends: R (>= 3.0.0), sandwich
+Imports: stats, methods, parallel
+Suggests: lmtest, knitr, texreg
+Collate: 'allClasses.R' 'validity.R' 'momentData.R' 'momentModel-methods.R'
+ 'momentModel.R' 'momentWeights-methods.R' 'gmmfit-methods.R'
+ 'specTest-methods.R' 'summary-methods.R' 'rModel-methods.R'
+ 'hypothesisTest-methods.R' 'sysMomentModel.R'
+ 'sysMomentModel-methods.R' 'rsysMomentModel-methods.R'
+ 'sgmmfit-methods.R' 'gmm4.R' 'gel.R' 'gelfit-methods.R' 'gel4.R'
+License: GPL (>= 2)
+NeedsCompilation: yes
+VignetteBuilder: knitr
Added: pkg/momentfit/NAMESPACE
===================================================================
--- pkg/momentfit/NAMESPACE (rev 0)
+++ pkg/momentfit/NAMESPACE 2020-01-21 03:40:21 UTC (rev 164)
@@ -0,0 +1,54 @@
+useDynLib(momentfit, .registration = TRUE, .fixes="F_")
+importFrom("methods", is, new, show, "slot<-", "slotNames", "validObject",
+ "getClassDef", "selectMethod", "callNextMethod", "as", "setAs",
+ "getMethod", "setOldClass", "existsFunction")
+
+importFrom("parallel", mclapply)
+
+importFrom("graphics", plot, polygon, grid, points, text)
+
+importFrom("grDevices", rgb, col2rgb)
+
+importFrom("utils", capture.output, head, tail)
+
+importFrom("stats", "ar", "as.formula", "model.matrix","vcov",
+ "model.response", "na.omit", "terms", "residuals",
+ "D", "numericDeriv", "sd", "optim", "lm", "pf", "coef", "update",
+ "fitted", "lm.fit", "pchisq", "pnorm", "printCoefmat", "anova",
+ "model.frame", "reformulate", "formula", "nlminb", "kernapply",
+ "constrOptim", "kernel", "confint", "qnorm", "uniroot", "getCall", "qchisq")
+importFrom("sandwich", "vcovHAC", "estfun","kernHAC","vcovCL", "meatCL",
+ "bread","bwAndrews","bwNeweyWest","weightsAndrews",
+ "weightsLumley", "vcovHC")
+
+### S4 Methods and Classes
+exportClasses("nonlinearModel", "linearModel", "functionModel", "momentModel",
+ "regModel", "allNLModel", "rmomentModel", "rlinearModel",
+ "rformulaModel", "momentWeights", "sysMomentWeights",
+ "rnonlinearModel", "rfunctionModel", "gmmfit",
+ "slinearModel", "snonlinearModel", "sysModel",
+ "rslinearModel", "rsnonlinearModel", "summarySysGmm",
+ "rsysModel", "formulaModel","rfunctionModel", "sSpec",
+ "summaryGmm", "specTest", "confint", "mconfint",
+ "hypothesisTest", "stsls", "sgmmfit", "gelfit", "summaryGel",
+ "tsls")
+
+exportMethods(print, show, kernapply, coef, model.matrix, bread, summary,
+ residuals, "[", vcovHAC, subset, update, vcov, plot, confint, merge)
+
+export(momentModel, modelResponse, evalMoment, Dresiduals, modelDims, evalDMoment,
+ evalWeights, evalGmmObj, solveGmm, momentStrength,
+ gmmFit, tsls, evalGmm, quadra, meatGmm, specTest, hypothesisTest, DWH,
+ printRestrict, restModel, getRestrict, gmm4, sysMomentModel, ThreeSLS,
+ rhoET, rhoEL, rhoEEL, rhoHD, Wu_lam, EEL_lam, REEL_lam, getLambda,
+ solveGel, rhoETEL, rhoETHD, ETXX_lam, gelFit, evalGel, getImpProb,
+ evalGelObj, momFct, gel4)
+
+### S3 methods ###
+
+### Need to find a better way
+S3method(estfun, momentFct)
+
+
+
+
Added: pkg/momentfit/NEWS
===================================================================
--- pkg/momentfit/NEWS (rev 0)
+++ pkg/momentfit/NEWS 2020-01-21 03:40:21 UTC (rev 164)
@@ -0,0 +1,4 @@
+Changes in version 0.0-2
+
+o Added restricted EEL (REEL), which imposes the implied probabilities to be non-negative.
+o Algorithms like WU for EL and EEL are now written in Fortran
Added: pkg/momentfit/R/allClasses.R
===================================================================
--- pkg/momentfit/R/allClasses.R (rev 0)
+++ pkg/momentfit/R/allClasses.R 2020-01-21 03:40:21 UTC (rev 164)
@@ -0,0 +1,337 @@
+##### All S4 classes of the package are defined here
+######################################################
+
+
+## Union Classes
+
+setClassUnion("matrixORcharacter", c("matrix", "character"))
+setClassUnion("matrixORnumeric", c("matrix", "numeric"))
+setClassUnion("numericORcharacter", c("numeric", "character"))
+setClassUnion("numericORNULL", c("numeric", "NULL"))
+setClassUnion("numericORlogical", c("numeric", "logical"))
+setClassUnion("numericORmatrixORNULL", c("matrix", "numeric", "NULL"))
+setClassUnion("expressionORNULL", c("expression", "NULL"))
+setClassUnion("functionORNULL", c("function", "NULL"))
+setClassUnion("callORNULL", c("call", "NULL"))
+
+
+## smooth spec class
+
+setOldClass("tskernel")
+setClass("sSpec", slots=list(k="numeric", kernel="character", bw="numeric",w="tskernel",
+ bwMet="character"),
+ prototype=list(w=kernel(1), bw=1, k=c(1,1), kernel="none", bwMet="none"))
+
+## moment based models
+setClass("linearModel", slots = list(modelF="data.frame", instF="data.frame",
+ vcov="character",n="integer", q="integer", k="integer",
+ parNames="character", momNames="character",
+ vcovOptions="list", centeredVcov="logical",
+ varNames="character", isEndo="logical",
+ omit='integer', survOptions="list",
+ sSpec="sSpec", smooth="logical"))
+setClass("nonlinearModel", slots = list(modelF="data.frame", instF="data.frame",
+ vcov="character",theta0="numeric",
+ n="integer", q="integer",k="integer",
+ parNames="character", momNames="character",
+ fRHS="expression", fLHS="expressionORNULL",
+ vcovOptions="list",
+ centeredVcov="logical", varNames="character",
+ isEndo="logical",omit='integer', survOptions="list",
+ sSpec="sSpec", smooth="logical"))
+setClass("functionModel", slots = list(X="ANY", fct="function",dfct="functionORNULL",
+ vcov="character",theta0="numeric",
+ n="integer", q="integer",k="integer",
+ parNames="character", momNames="character",
+ vcovOptions="list",
+ centeredVcov="logical", varNames="character",
+ isEndo="logical",omit='integer', survOptions="list",
+ sSpec="sSpec", smooth="logical"))
+setClass("formulaModel", slots = list(modelF="data.frame",
+ vcov="character",theta0="numeric",
+ n="integer", q="integer",k="integer",
+ parNames="character", momNames="character",
+ fRHS="list", fLHS="list",
+ vcovOptions="list",
+ centeredVcov="logical", varNames="character",
+ isEndo="logical", isMDE="logical",omit='integer',
+ survOptions="list",sSpec="sSpec", smooth="logical"))
+setClassUnion("regModel", c("linearModel", "nonlinearModel"))
+setClassUnion("allNLModel", c("nonlinearModel", "functionModel", "formulaModel"))
+setClassUnion("momentModel", c("linearModel", "nonlinearModel", "functionModel", "formulaModel"))
+
+## Restricted Models
+
+setClass("rlinearModel", slots = list(cstLHS="matrix", cstRHS="numeric", cstSpec="list"),
+ contains="linearModel")
+
+setClass("rnonlinearModel", slots = list(R="list", cstSpec="list"),
+ contains="nonlinearModel")
+
+setClass("rfunctionModel", slots = list(R="list", cstSpec="list"),
+ contains="functionModel")
+
+setClass("rformulaModel", slots = list(R="list", cstSpec="list"),
+ contains="formulaModel")
+
+setClassUnion("rmomentModel", c("rlinearModel", "rnonlinearModel", "rfunctionModel",
+ "rformulaModel"))
+
+### System models
+
+setClass("slinearModel", slots = list(modelT="list", instT="list",data="data.frame",
+ vcov="character",n="integer", q="integer",
+ k="integer", parNames="list",
[TRUNCATED]
To get the complete diff run:
svnlook diff /svnroot/gmm -r 164
More information about the Gmm-commits
mailing list