[Gmm-commits] r234 - in pkg/momentfit: R man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Tue Apr 2 21:26:27 CEST 2024
Author: chaussep
Date: 2024-04-02 21:26:26 +0200 (Tue, 02 Apr 2024)
New Revision: 234
Modified:
pkg/momentfit/R/gel.R
pkg/momentfit/R/gelfit-methods.R
pkg/momentfit/R/gmmfit-methods.R
pkg/momentfit/R/momentModel-methods.R
pkg/momentfit/R/rModel-methods.R
pkg/momentfit/R/summary-methods.R
pkg/momentfit/man/gmmFit-methods.Rd
pkg/momentfit/man/subsetting.Rd
Log:
fixing several bugs when no estimation is needed
Modified: pkg/momentfit/R/gel.R
===================================================================
--- pkg/momentfit/R/gel.R 2024-03-27 19:38:43 UTC (rev 233)
+++ pkg/momentfit/R/gel.R 2024-04-02 19:26:26 UTC (rev 234)
@@ -159,8 +159,10 @@
if (chk3)
mes <- c(mes, "Some values of the moment matrix gt are not finite")
if (length(mes))
- {
- return(list(lambda = as.numeric(rep(NA, ncol(gmat))),
+ {
+ lambda <- rep(NA, length(restrictedLam)+ncol(gmat))
+ lambda[restrictedLam] <- 0
+ return(list(lambda = lambda,
convergence = list(convergence=1, message=mes), obj= NA))
}
if (is.null(lambda0))
Modified: pkg/momentfit/R/gelfit-methods.R
===================================================================
--- pkg/momentfit/R/gelfit-methods.R 2024-03-27 19:38:43 UTC (rev 233)
+++ pkg/momentfit/R/gelfit-methods.R 2024-04-02 19:26:26 UTC (rev 234)
@@ -135,12 +135,16 @@
"\n", sep="")
}
cat("coefficients:\n")
- print.default(format(theta, ...), print.gap=2L, quote=FALSE)
+ if (length(theta))
+ print.default(format(theta, ...), print.gap=2L, quote=FALSE)
+ else
+ cat("\tNo estimated coefficients\n")
if (lambda)
{
cat("lambdas:\n")
print.default(format(x at lambda, ...), print.gap=2L, quote=FALSE)
}
+ invisible()
})
## show
@@ -629,7 +633,10 @@
digits=5), "\n", sep="")
cat("\ncoefficients:\n")
- printCoefmat(x at coef, digits=digits, ...)
+ if (nrow(x at coef))
+ printCoefmat(x at coef, digits=digits, ...)
+ else
+ cat("\tNo estimated coefficients\n")
if (lambda)
{
cat("\nLambdas:\n")
Modified: pkg/momentfit/R/gmmfit-methods.R
===================================================================
--- pkg/momentfit/R/gmmfit-methods.R 2024-03-27 19:38:43 UTC (rev 233)
+++ pkg/momentfit/R/gmmfit-methods.R 2024-04-02 19:26:26 UTC (rev 234)
@@ -21,16 +21,24 @@
"twostep","iter","cue","onestep","tsls", "eval","mde"),
ncol=2)
type <- ntype[match(x at type, ntype[,2]),1]
+ if (is.na(type))
+ type <- x at type
spec <- modelDims(x at model)
if (spec$q==spec$k && x at type != "eval")
type <- "One-Step, Just-Identified"
cat("\nEstimation: ", type,"\n")
- if (!is.null(x at convergence))
- cat("Convergence Optim: ", x at convergence, "\n")
- if (!is.null(x at convIter))
- cat("Convergence Iteration: ", x at convIter, "\n")
- cat("coefficients:\n")
- print.default(format(theta, ...), print.gap=2L, quote=FALSE)
+ if (length(theta))
+ {
+ if (!is.null(x at convergence))
+ cat("Convergence Optim: ", x at convergence, "\n")
+ if (!is.null(x at convIter))
+ cat("Convergence Iteration: ", x at convIter, "\n")
+ cat("coefficients:\n")
+ print.default(format(theta, ...), print.gap=2L, quote=FALSE)
+ } else {
+ cat("coefficients:\n\tNo estimated coefficients\n")
+ }
+ invisible()
})
## show
@@ -50,7 +58,7 @@
if (length(coef(object)) == 0)
{
vcov <- matrix(nrow=0, ncol=0)
- attr(vcov, "type") <- list(sandwich=sandwich, df.adj=df.adj,
+ attr(vcov, "type") <- list(sandwich=TRUE, df.adj=FALSE,
breadOnly=breadOnly)
return(vcov)
}
Modified: pkg/momentfit/R/momentModel-methods.R
===================================================================
--- pkg/momentfit/R/momentModel-methods.R 2024-03-27 19:38:43 UTC (rev 233)
+++ pkg/momentfit/R/momentModel-methods.R 2024-04-02 19:26:26 UTC (rev 234)
@@ -1309,12 +1309,6 @@
}
if (is.null(lambda0))
lambda0 <- rep(0, modelDims(object)$q)
- if (is.null(theta0))
- {
- if (!("theta0"%in%slotNames(object)))
- stop("theta0 must be provided")
- theta0 <- modelDims(object)$theta0
- }
if (is.null(lamSlv))
lamSlv <- getLambda
if (modelDims(object)$k == 0)
@@ -1321,6 +1315,12 @@
return(evalGel(object, theta=numeric(), gelType=gelType,
rhoFct=rhoFct, lambda0=lambda0, lamSlv=lamSlv,
lControl=lControl))
+ if (is.null(theta0))
+ {
+ if (!("theta0"%in%slotNames(object)))
+ stop("theta0 must be provided")
+ theta0 <- modelDims(object)$theta0
+ }
if (coefSlv == "nlminb")
{
args <- c(list(start=theta0, objective=f, gelType=gelType,
@@ -1438,7 +1438,7 @@
paste(mes, collapse="\n")))))
type <- paste(type, " with optimal lambda", sep="")
} else {
- lconvergence <- 1
+ lconvergence <- as.numeric(NA)
type <- paste(type, " with fixed lambda", sep="")
.restrictedLam <- integer()
}
@@ -1445,7 +1445,8 @@
names(lambda) <- spec$momNames
if (!is.null(rhoFct))
gelType <- "Other"
- new("gelfit", theta=theta, convergence=1, lconvergence=lconvergence,
+ new("gelfit", theta=theta, convergence=as.numeric(NA),
+ lconvergence=lconvergence,
lambda=lambda, call=Call, gelType=list(name=gelType, rhoFct=rhoFct),
vcov=list(), model=model, restrictedLam = .restrictedLam)
})
Modified: pkg/momentfit/R/rModel-methods.R
===================================================================
--- pkg/momentfit/R/rModel-methods.R 2024-03-27 19:38:43 UTC (rev 233)
+++ pkg/momentfit/R/rModel-methods.R 2024-04-02 19:26:26 UTC (rev 234)
@@ -699,16 +699,6 @@
)
-## Subsetting '['
-
-setMethod("[", c("rfunctionModel", "numeric", "missing"),
- function(x, i, j){
- Call <- match.call(call=sys.call(sys.parent()))
- obj <- callNextMethod()
- obj at call <- Call
- obj
- })
-
## gmmfit
setMethod("gmmFit", signature("rlinearModel"), valueClass="gmmfit",
@@ -722,12 +712,17 @@
if (cst$k==0)
{
theta <- coef(model, numeric())
- model <- as(model, "linearModel")
+ model2 <- as(model, "linearModel")
if (inherits(weights,"momentWeights"))
wObj <- weights
else
- wObj <- evalWeights(model, theta=theta, w=weights)
- obj <- evalGmm(model, theta, wObj)
+ wObj <- evalWeights(model2, theta=theta, w=weights)
+ ## obj <- evalGmm(model, theta, wObj)
+ ## Not really evalGmm. it is a model without estimation
+ obj <- new("gmmfit", theta=numeric(), convergence=as.numeric(NA),
+ convIter=NULL, call=Call,
+ type="No estimation needed",
+ wObj=wObj, niter=1L, efficientGmm=FALSE, model=model)
} else {
obj <- callNextMethod()
}
@@ -746,12 +741,17 @@
if (cst$k==0)
{
theta <- coef(model, numeric())
- model <- as(model, "nonlinearModel")
+ model2 <- as(model, "nonlinearModel")
if (inherits(weights,"momentWeights"))
wObj <- weights
else
- wObj <- evalWeights(model, theta=theta, w=weights)
- obj <- evalGmm(model, theta, wObj, Call=FALSE)
+ wObj <- evalWeights(model2, theta=theta, w=weights)
+ ## obj <- evalGmm(model, theta, wObj)
+ ## Not really evalGmm. it is a model without estimation
+ obj <- new("gmmfit", theta=numeric(), convergence=as.numeric(NA),
+ convIter=NULL, call=Call,
+ type="No estimation needed",
+ wObj=wObj, niter=1L, efficientGmm=FALSE, model=model)
} else {
obj <- callNextMethod()
}
@@ -770,12 +770,17 @@
if (cst$k==0)
{
theta <- coef(model, numeric())
- model <- as(model, "formulaModel")
+ model2 <- as(model, "formulaModel")
if (inherits(weights,"momentWeights"))
wObj <- weights
else
- wObj <- evalWeights(model, theta=theta, w=weights)
- obj <- evalGmm(model, theta, wObj)
+ wObj <- evalWeights(model2, theta=theta, w=weights)
+ ## obj <- evalGmm(model, theta, wObj)
+ ## Not really evalGmm. it is a model without estimation
+ obj <- new("gmmfit", theta=numeric(), convergence=as.numeric(NA),
+ convIter=NULL, call=Call,
+ type="No estimation needed",
+ wObj=wObj, niter=1L, efficientGmm=FALSE, model=model)
} else {
obj <- callNextMethod()
}
@@ -783,7 +788,36 @@
obj
})
+setMethod("gmmFit", signature("rfunctionModel"), valueClass="gmmfit",
+ definition = function(model, type=c("twostep", "iter","cue", "onestep"),
+ itertol=1e-7, initW=c("ident", "tsls"), weights="optimal",
+ itermaxit=100, efficientWeights=FALSE, theta0=NULL, ...) {
+ Call <- try(match.call(call=sys.call(sys.parent())), silent=TRUE)
+ if (inherits(Call,"try-error"))
+ Call <- NULL
+ cst <- model at cstSpec
+ if (cst$k==0)
+ {
+ theta <- coef(model, numeric())
+ model2 <- as(model, "functionModel")
+ if (inherits(weights,"momentWeights"))
+ wObj <- weights
+ else
+ wObj <- evalWeights(model2, theta=theta, w=weights)
+ ## obj <- evalGmm(model, theta, wObj)
+ ## Not really evalGmm. it is a model without estimation
+ obj <- new("gmmfit", theta=numeric(), convergence=as.numeric(NA),
+ convIter=NULL, call=Call,
+ type="No estimation needed",
+ wObj=wObj, niter=1L, efficientGmm=FALSE, model=model)
+ } else {
+ obj <- callNextMethod()
+ }
+ obj at call <- Call
+ obj
+ })
+
### momentStrength
### For now, there is no measure of moment strength in restricted models
### Have to figure out how to identify exluded instruments after
Modified: pkg/momentfit/R/summary-methods.R
===================================================================
--- pkg/momentfit/R/summary-methods.R 2024-03-27 19:38:43 UTC (rev 233)
+++ pkg/momentfit/R/summary-methods.R 2024-04-02 19:26:26 UTC (rev 234)
@@ -12,17 +12,21 @@
"twostep","iter","cue","onestep","tsls", "eval","mde"),
ncol=2)
type <- ntype[match(x at type, ntype[, 2]), 1]
+ if (is.na(type))
+ type <- x at type
spec <- modelDims(x at model)
if (spec$q == spec$k)
type <- "One-Step, Just-Identified"
cat("\nEstimation: ", type, "\n")
- if (!is.null(x at convergence))
- cat("Convergence Optim: ", x at convergence, "\n")
- if (!is.null(x at convIter))
- cat("Convergence Iteration: ", x at convIter, "\n")
- if (x at type == "iter")
- cat("Number of iterations: ", x at niter, "\n")
- if (length(x at wSpec) > 0)
+ if (nrow(x at coef))
+ {
+ if (!is.null(x at convergence))
+ cat("Convergence Optim: ", x at convergence, "\n")
+ if (!is.null(x at convIter))
+ cat("Convergence Iteration: ", x at convIter, "\n")
+ if (x at type == "iter")
+ cat("Number of iterations: ", x at niter, "\n")
+ if (length(x at wSpec) > 0)
{
if (is.numeric(x at model@vcovOptions$bw))
cat("Fixed Bandwidth: ", round(x at wSpec$bw, 3), "\n", sep="")
@@ -30,21 +34,24 @@
cat(x at model@vcovOptions$bw,
" Bandwidth: ", round(x at wSpec$bw, 3), "\n", sep="")
}
- if (x at breadOnly)
+ if (x at breadOnly)
{
cat("vcov type: Bread \n")
} else {
cat("Sandwich vcov: ", x at sandwich, "\n", sep="")
if (x at sandwich && x at model@vcov == "MDS")
- {
- v <- ifelse(x at df.adj, "HC1", "HC0")
- cat("Type of sandwich HCCM :", v, "\n", sep="")
- } else if (x at sandwich && x at model@vcov == "HAC") {
- cat("Type of sandwich HAC: as specified in the model definition\n")
- }
+ {
+ v <- ifelse(x at df.adj, "HC1", "HC0")
+ cat("Type of sandwich HCCM :", v, "\n", sep="")
+ } else if (x at sandwich && x at model@vcov == "HAC") {
+ cat("Type of sandwich HAC: as specified in the model definition\n")
+ }
}
- cat("coefficients:\n")
- printCoefmat(x at coef, digits=digits, ...)
+ cat("coefficients:\n")
+ printCoefmat(x at coef, digits=digits, ...)
+ } else {
+ cat("coefficients:\n\tNo estimated coefficients\n")
+ }
print(x at specTest)
str <- x at strength
if (!is.null(str$strength)) {
Modified: pkg/momentfit/man/gmmFit-methods.Rd
===================================================================
--- pkg/momentfit/man/gmmFit-methods.Rd 2024-03-27 19:38:43 UTC (rev 233)
+++ pkg/momentfit/man/gmmFit-methods.Rd 2024-04-02 19:26:26 UTC (rev 234)
@@ -9,6 +9,7 @@
\alias{gmmFit,rformulaModel-method}
\alias{gmmFit,rslinearModel-method}
\alias{gmmFit,rnonlinearModel-method}
+\alias{gmmFit,rfunctionModel-method}
\title{ ~~ Methods for Function \code{gmmFit} in Package \pkg{momentfit} ~~}
\description{
Method to fit a model using GMM, from an object of class
Modified: pkg/momentfit/man/subsetting.Rd
===================================================================
--- pkg/momentfit/man/subsetting.Rd 2024-03-27 19:38:43 UTC (rev 233)
+++ pkg/momentfit/man/subsetting.Rd 2024-04-02 19:26:26 UTC (rev 234)
@@ -15,7 +15,6 @@
\alias{[,regModel,numeric,missing-method}
\alias{[,functionModel,numeric,missing-method}
\alias{[,formulaModel,numeric,missing-method}
-\alias{[,rfunctionModel,numeric,missing-method}
\alias{[,sysModel,missing,list-method}
\alias{[,snonlinearModel,numeric,missing-method}
\alias{[,sfunctionModel,numeric,missing-method}
More information about the Gmm-commits
mailing list