[Gmm-commits] r188 - in pkg/momentfit: . R man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Wed Oct 20 23:46:52 CEST 2021
Author: chaussep
Date: 2021-10-20 23:46:52 +0200 (Wed, 20 Oct 2021)
New Revision: 188
Added:
pkg/momentfit/man/sfunctionModel-class.Rd
Modified:
pkg/momentfit/NAMESPACE
pkg/momentfit/R/allClasses.R
pkg/momentfit/R/sysMomentModel-methods.R
pkg/momentfit/R/sysMomentModel.R
pkg/momentfit/man/modelDims-methods.Rd
pkg/momentfit/man/solveGmm-methods.Rd
pkg/momentfit/man/subsetting.Rd
pkg/momentfit/man/sysMomentModel.Rd
Log:
started to add systems of functions
Modified: pkg/momentfit/NAMESPACE
===================================================================
--- pkg/momentfit/NAMESPACE 2021-10-15 04:29:56 UTC (rev 187)
+++ pkg/momentfit/NAMESPACE 2021-10-20 21:46:52 UTC (rev 188)
@@ -27,6 +27,7 @@
"rformulaModel", "momentWeights", "sysMomentWeights",
"rnonlinearModel", "rfunctionModel", "gmmfit",
"slinearModel", "snonlinearModel", "sysModel",
+ "sfunctionModel",
"rslinearModel", "rsnonlinearModel", "summarySysGmm",
"rsysModel", "formulaModel","rfunctionModel", "sSpec",
"summaryGmm", "specTest", "confint", "mconfint",
Modified: pkg/momentfit/R/allClasses.R
===================================================================
--- pkg/momentfit/R/allClasses.R 2021-10-15 04:29:56 UTC (rev 187)
+++ pkg/momentfit/R/allClasses.R 2021-10-20 21:46:52 UTC (rev 188)
@@ -101,10 +101,22 @@
omit='integer', survOptions="list",
sSpec="sSpec", smooth="logical"))
-setClassUnion("sysModel", c("slinearModel", "snonlinearModel"))
+setClass("sfunctionModel", slots = list(X="ANY", fct="list", dfct="list",
+ vcov="character",theta0="list",
+ n="integer", q="integer",k="integer",
+ parNames="list", momNames="list",
+ eqnNames="character", vcovOptions="list",
+ centeredVcov="logical",
+ varNames="list",
+ sameMom="logical", SUR="logical",
+ omit='integer', survOptions="list",
+ sSpec="sSpec", smooth="logical"))
+setClassUnion("sysModel", c("slinearModel", "snonlinearModel",
+ "sfunctionModel"))
+
## Restricted System models
setClass("rslinearModel", slots = list(cstLHS="matrix", cstRHS="numeric", cstSpec="list"),
Modified: pkg/momentfit/R/sysMomentModel-methods.R
===================================================================
--- pkg/momentfit/R/sysMomentModel-methods.R 2021-10-15 04:29:56 UTC (rev 187)
+++ pkg/momentfit/R/sysMomentModel-methods.R 2021-10-20 21:46:52 UTC (rev 188)
@@ -49,6 +49,13 @@
isEndo=object at isEndo)
})
+setMethod("modelDims", "sfunctionModel",
+ function(object) {
+ list(k=object at k, q=object at q, n=object at n, parNames=object at parNames,
+ momNames=object at momNames, theta0=object at theta0,
+ fct=object at fct, eqnNames=object at eqnNames)
+ })
+
## setCoef
## Used to validate and format the coefficient into a named list
@@ -192,6 +199,38 @@
})
+setMethod("[", c("sfunctionModel", "numeric", "missing"),
+ function(x, i, j){
+ i <- unique(as.integer(i))
+ spec <- modelDims(x)
+ neqn <- length(spec$k)
+ if (!all(abs(i) %in% (1:neqn)))
+ stop("Selected equations out of range")
+ x at fct <- x at fct[i]
+ x at dfct <- x at dfct[i]
+ if (length(x at fct) == 0)
+ stop("Removed too many equations; the model is empty")
+ x at k=x at k[i]
+ x at q <- x at q[i]
+ x at parNames <- x at parNames[i]
+ x at momNames <- x at momNames[i]
+ x at eqnNames <- x at eqnNames[i]
+ x at theta0 <- x at theta0[i]
+ x at varNames <- x at varNames[i]
+ if (length(x at q) > 1)
+ return(x)
+ new("functionModel", X=x at X, fct=x at fct[[1]],
+ dfct=x at dfct[[1]],
+ theta0=x at theta0[[1]], vcov=x at vcov,
+ vcovOptions=x at vcovOptions,
+ centeredVcov = x at centeredVcov, k=x at k[[1]], q=x at q[[1]],
+ n=x at n, parNames=x at parNames[[1]],
+ momNames=x at momNames[[1]], varNames=x at varNames[[1]],
+ isEndo=logical(), omit=x at omit,
+ survOptions=x at survOptions, smooth=x at smooth)
+ })
+
+
setMethod("[", c("slinearModel", "numeric", "missing"),
function(x, i, j){
i <- unique(as.integer(i))
@@ -223,6 +262,7 @@
sSpec=new("sSpec"), smooth=FALSE)
})
+
setMethod("[", c("sysModel", "numeric", "list"),
function(x, i, j){
x <- x[i]
@@ -675,6 +715,15 @@
list(theta = theta, convergence = res$convergence)
})
+
+setMethod("solveGmm", signature("sfunctionModel", "sysMomentWeights"),
+ function (object, wObj, theta0 = NULL, ...)
+ {
+ met <- getMethod("solveGmm",
+ c("snonlinearModel", "sysMomentWeights"))
+ met(object, wObj, theta0, ...)
+ })
+
## vcov
setMethod("vcov", signature("sysModel"),
Modified: pkg/momentfit/R/sysMomentModel.R
===================================================================
--- pkg/momentfit/R/sysMomentModel.R 2021-10-15 04:29:56 UTC (rev 187)
+++ pkg/momentfit/R/sysMomentModel.R 2021-10-20 21:46:52 UTC (rev 188)
@@ -1,9 +1,69 @@
################## Constructor for the sysGmmModels classes #####################
-sysMomentModel <- function(g, h=NULL, theta0=NULL,
+.sysFct <- function(g, h=NULL, theta0=NULL,grad=NULL,
+ vcov = c("iid", "HAC", "MDS", "CL"),
+ vcovOptions=list(), centeredVcov = TRUE, data=parent.frame(),
+ na.action="na.omit", survOptions=list())
+{
+ vcov <- match.arg(vcov)
+ if (vcov == "iid")
+ vcov <- "MDS"
+ if (!is.list(g))
+ stop("g must be a list")
+ if (!all(sapply(g, function(gi)
+ inherits(gi, "function"))))
+ stop("g must be a list of functions")
+ if (!is.list(theta0))
+ stop("theta0 must be a list")
+ if (length(g) != length(theta0))
+ stop("The length of g and theta0 must be the same")
+ neqn <- length(g)
+ if (is.null(grad))
+ {
+ grad <- lapply(1:neqn, function(i) NULL)
+ } else {
+ if (!is.list(grad))
+ stop("grad must be a list")
+ if (length(grad) != neqn)
+ stop("The length is grad must be equal to the length of g")
+ }
+ if (is.null(names(g)))
+ {
+ eqnNames <- paste("Eqn", 1:neqn, sep="")
+ } else {
+ eqnNames <- names(g)
+ }
+ mod <- lapply(1:neqn, function(i)
+ momentModel(g=g[[i]], x=h, theta0=theta0[[i]],grad=grad[[i]],
+ vcov=vcov, vcovOptions=vcovOptions,
+ centeredVcov=centeredVcov, data=data,
+ na.action=na.action, survOptions=survOptions,
+ smooth=FALSE))
+ new("sfunctionModel",
+ X=mod[[1]]@X,
+ fct=lapply(mod, function(mi) mi at fct),
+ dfct=lapply(mod, function(mi) mi at dfct),
+ vcov=mod[[1]]@vcov,
+ theta0=lapply(mod, function(mi) mi at theta0),
+ n=mod[[1]]@n,
+ q=sapply(mod, function(mi) mi at q),
+ k=sapply(mod, function(mi) mi at k),
+ parNames=lapply(mod, function(mi) mi at parNames),
+ momNames=lapply(mod, function(mi) mi at momNames),
+ eqnNames=eqnNames, vcovOptions=mod[[1]]@vcovOptions,
+ centeredVcov=mod[[1]]@centeredVcov,
+ sameMom=FALSE, SUR=FALSE,
+ varNames=lapply(mod, function(mi) mi at varNames),
+ omit=mod[[1]]@omit, survOptions=mod[[1]]@survOptions,
+ sSpec=mod[[1]]@sSpec, smooth=mod[[1]]@smooth)
+}
+
+
+sysMomentModel <- function(g, h=NULL, theta0=NULL,grad=NULL,
vcov = c("iid", "HAC", "MDS", "CL"),
- vcovOptions=list(), centeredVcov = TRUE, data=parent.frame(),
+ vcovOptions=list(), centeredVcov = TRUE,
+ data=parent.frame(),
na.action="na.omit", survOptions=list())
{
vcov <- match.arg(vcov)
@@ -15,6 +75,13 @@
stop("'data' must be a list or an environment")
if (!is.list(g))
stop("For system of equations, g must be lists of formulas")
+ if (all(sapply(g, function(gi) inherits(gi, "function"))))
+ {
+ mod <- .sysFct(g, h, theta0,grad, vcov,
+ vcovOptions, centeredVcov, data,
+ na.action="na.omit", survOptions=list())
+ return(mod)
+ }
clg <- sapply(g, class)
if (!all(clg=="formula"))
stop("For system of equations, g must be lists of formulas")
Modified: pkg/momentfit/man/modelDims-methods.Rd
===================================================================
--- pkg/momentfit/man/modelDims-methods.Rd 2021-10-15 04:29:56 UTC (rev 187)
+++ pkg/momentfit/man/modelDims-methods.Rd 2021-10-20 21:46:52 UTC (rev 188)
@@ -8,6 +8,7 @@
\alias{modelDims,sysMomentModel-method}
\alias{modelDims,slinearModel-method}
\alias{modelDims,snonlinearModel-method}
+\alias{modelDims,sfunctionModel-method}
\alias{modelDims,nonlinearModel-method}
\alias{modelDims,functionModel-method}
\alias{modelDims,formulaModel-method}
@@ -57,8 +58,11 @@
\item{\code{signature(object = "rsnonlinearModel")}}{
}
-\item{\code{signature(object = "snonlineatModel")}}{
+\item{\code{signature(object = "snonlinearModel")}}{
}
+
+\item{\code{signature(object = "sfunctionModel")}}{
+}
}}
\examples{
data(simData)
Added: pkg/momentfit/man/sfunctionModel-class.Rd
===================================================================
--- pkg/momentfit/man/sfunctionModel-class.Rd (rev 0)
+++ pkg/momentfit/man/sfunctionModel-class.Rd 2021-10-20 21:46:52 UTC (rev 188)
@@ -0,0 +1,45 @@
+\name{sfunctionModel-class}
+\docType{class}
+\alias{sfunctionModel-class}
+
+\title{Class \code{"sfunctionModel"}}
+\description{
+A class for systems of nonlinear equations.
+}
+\section{Objects from the Class}{
+Objects can be created by calls of the form \code{new("sfunctionModel", ...)}.
+It is created by \code{\link{momentModel}}.
+}
+
+\section{Slots}{
+ \describe{
+ \item{\code{X}:}{Object of class \code{"ANY"} ~~ }
+ \item{\code{fct}:}{Object of class \code{"list"} ~~ }
+ \item{\code{dfct}:}{Object of class \code{"list"} ~~ }
+ \item{\code{vcov}:}{Object of class \code{"character"} ~~ }
+ \item{\code{theta0}:}{Object of class \code{"list"} ~~ }
+ \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{"list"} ~~ }
+ \item{\code{momNames}:}{Object of class \code{"list"} ~~ }
+ \item{\code{eqnNames}:}{Object of class \code{"character"} ~~ }
+ \item{\code{vcovOptions}:}{Object of class \code{"list"} ~~ }
+ \item{\code{centeredVcov}:}{Object of class \code{"logical"} ~~ }
+ \item{\code{sameMom}:}{Object of class \code{"logical"} ~~ }
+ \item{\code{SUR}:}{Object of class \code{"logical"} ~~ }
+ \item{\code{varNames}:}{Object of class \code{"list"} ~~ }
+ \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{sysModel}"}, directly.
+}
+
+\examples{
+showClass("sfunctionModel")
+}
+\keyword{classes}
Modified: pkg/momentfit/man/solveGmm-methods.Rd
===================================================================
--- pkg/momentfit/man/solveGmm-methods.Rd 2021-10-15 04:29:56 UTC (rev 187)
+++ pkg/momentfit/man/solveGmm-methods.Rd 2021-10-20 21:46:52 UTC (rev 188)
@@ -7,6 +7,7 @@
\alias{solveGmm,slinearModel,sysMomentWeights-method}
\alias{solveGmm,rslinearModel,sysMomentWeights-method}
\alias{solveGmm,snonlinearModel,sysMomentWeights-method}
+\alias{solveGmm,sfunctionModel,sysMomentWeights-method}
\alias{solveGmm,rnonlinearModel,momentWeights-method}
\title{ ~~ Methods for Function \code{solveGmm} in Package \pkg{momentfit} ~~}
\description{
@@ -28,6 +29,9 @@
\S4method{solveGmm}{snonlinearModel,sysMomentWeights}(object, wObj,
theta0=NULL, \dots)
+
+\S4method{solveGmm}{sfunctionModel,sysMomentWeights}(object, wObj,
+theta0=NULL, \dots)
}
\arguments{
\item{object}{A moment-based model}
Modified: pkg/momentfit/man/subsetting.Rd
===================================================================
--- pkg/momentfit/man/subsetting.Rd 2021-10-15 04:29:56 UTC (rev 187)
+++ pkg/momentfit/man/subsetting.Rd 2021-10-20 21:46:52 UTC (rev 188)
@@ -18,6 +18,7 @@
\alias{[,rfunctionModel,numeric,missing-method}
\alias{[,sysModel,missing,list-method}
\alias{[,snonlinearModel,numeric,missing-method}
+\alias{[,sfunctionModel,numeric,missing-method}
\alias{[,slinearModel,numeric,missing-method}
\alias{[,rsnonlinearModel,numeric,missing-method}
\alias{[,rslinearModel,numeric,missing-method}
Modified: pkg/momentfit/man/sysMomentModel.Rd
===================================================================
--- pkg/momentfit/man/sysMomentModel.Rd 2021-10-15 04:29:56 UTC (rev 187)
+++ pkg/momentfit/man/sysMomentModel.Rd 2021-10-20 21:46:52 UTC (rev 188)
@@ -10,7 +10,7 @@
conditions.
}
\usage{
-sysMomentModel(g, h=NULL, theta0=NULL,
+sysMomentModel(g, h=NULL, theta0=NULL, grad=NULL,
vcov = c("iid", "HAC", "MDS", "CL"),
vcovOptions=list(), centeredVcov = TRUE,
data=parent.frame(),na.action="na.omit",
@@ -28,6 +28,9 @@
list of named vector, with the names corresponding to the coefficient
names in the regression formulas.}
+\item{grad}{A list of functions that returns the derivative of the
+ moment functions. Only used if \code{g} is a list of functions.}
+
\item{vcov}{Assumption on the properties of the moment conditions. By
default, they are weakly dependant processes. For \code{MDS}, we
assume that the conditions are martingale difference sequences, which
More information about the Gmm-commits
mailing list