[Gmm-commits] r207 - in pkg: causalOTLSE/R momentfit momentfit/R momentfit/man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Fri Mar 10 16:21:26 CET 2023
Author: chaussep
Date: 2023-03-10 16:21:26 +0100 (Fri, 10 Mar 2023)
New Revision: 207
Modified:
pkg/causalOTLSE/R/otlse.R
pkg/momentfit/DESCRIPTION
pkg/momentfit/R/gmmfit-methods.R
pkg/momentfit/R/momentModel-methods.R
pkg/momentfit/R/sgmmfit-methods.R
pkg/momentfit/man/summary-methods.Rd
Log:
add the option of not computing the moment strength in summary
Modified: pkg/causalOTLSE/R/otlse.R
===================================================================
--- pkg/causalOTLSE/R/otlse.R 2022-12-05 16:06:26 UTC (rev 206)
+++ pkg/causalOTLSE/R/otlse.R 2023-03-10 15:21:26 UTC (rev 207)
@@ -6,7 +6,7 @@
if (is.null(knots))
return(as.matrix(X))
if (any(is.na(knots))) {
- p <- floor(n^pFact)
+ p <- if (pFact==0) max(floor(log(n)),2) else floor(n^pFact)
prop.seq <- seq(from = 0, to = 1, length.out = p + 1)
prop.seq <- prop.seq[-c(1, p + 1)]
knots <- quantile(X, probs = prop.seq, type = 1)
@@ -13,8 +13,7 @@
}
if (method == "bs") {
Xfi <- bs(x = X, knots = knots, degree = deg)
- }
- else {
+ } else {
p <- length(knots) + 1
Xfi <- matrix(nrow = n, ncol = p)
Xfi[, 1] <- X * (X <= knots[1]) + knots[1] * (X > knots[1])
@@ -180,7 +179,6 @@
ans
}
-
selASY <- function (form, data, pFact = 0.3, splineMet = c("manual", "bs"),
HCtype="HC", mZeroProp=0.1, knots0=NA, knots1=NA,
minPV=function(p) 1/(p*log(p)))
@@ -348,7 +346,6 @@
treatment=colnames(Z))
}
-
otlse <- function(form, data, crit = c("ASY", "AIC", "BIC", "CV", "NONE"),
pFact=0.3, splineMet=c("manual","bs"), HCtype="HC",
mZeroProp=0.1, knots0=NA, knots1=NA, ...)
Modified: pkg/momentfit/DESCRIPTION
===================================================================
--- pkg/momentfit/DESCRIPTION 2022-12-05 16:06:26 UTC (rev 206)
+++ pkg/momentfit/DESCRIPTION 2023-03-10 15:21:26 UTC (rev 207)
@@ -1,6 +1,6 @@
Package: momentfit
-Version: 0.4
-Date: 2022-12-04
+Version: 0.5
+Date: 2023-03-10
Title: Methods of Moments
Author: Pierre Chausse <pchausse at uwaterloo.ca>
Maintainer: Pierre Chausse <pchausse at uwaterloo.ca>
Modified: pkg/momentfit/R/gmmfit-methods.R
===================================================================
--- pkg/momentfit/R/gmmfit-methods.R 2022-12-05 16:06:26 UTC (rev 206)
+++ pkg/momentfit/R/gmmfit-methods.R 2023-03-10 15:21:26 UTC (rev 207)
@@ -172,7 +172,7 @@
setGeneric("summary")
setMethod("summary", "gmmfit",
- function(object, ...)
+ function(object, testStrength=TRUE, ...)
{
v <- vcov(object, ...)
se <- sqrt(diag(v))
@@ -187,7 +187,9 @@
iid="OLS",
MDS="HC",
CL="CL")
- strength <- momentStrength(object at model, coef(object), vcovType)
+ strength <- if (testStrength){
+ momentStrength(object at model, coef(object), vcovType)
+ } else { list(strength=NULL, mess=NULL) }
dimnames(coef) <- list(names(par),
c("Estimate", "Std. Error", "t value", "Pr(>|t|)"))
wSpec <- object at wObj@wSpec
Modified: pkg/momentfit/R/momentModel-methods.R
===================================================================
--- pkg/momentfit/R/momentModel-methods.R 2022-12-05 16:06:26 UTC (rev 206)
+++ pkg/momentfit/R/momentModel-methods.R 2023-03-10 15:21:26 UTC (rev 207)
@@ -718,42 +718,55 @@
setMethod("momentStrength", signature("linearModel"),
function(object, theta, vcovType=c("OLS","HC","HAC","CL")){
spec <- modelDims(object)
+ getF <- function(i)
+ {
+ resu <- lm(X[, i] ~ Z - 1)
+ v <- switch(vcovType, OLS = vcov(resu),
+ HC = vcovHC(resu, "HC1"),
+ HAC = vcovHAC(resu),
+ CL = do.call(vcovCL, c(object at vcovOptions, list(x = resu))))
+ v <- v[!exoInst, !exoInst]
+ b <- coef(resu)[!exoInst]
+ f <- b %*% solve(v, b)/df1
+ df2 <- resu$df.residual
+ c(f, df1, df2)
+ }
EndoVars <- !(spec$parNames %in% spec$momNames)
exoInst <- spec$momNames %in% spec$parNames
vcovType <- match.arg(vcovType)
- if (all(!EndoVars))
- {
- fstats <- NULL
- mess <- "No endogenous variables: no strength measure"
- } else {
- X <- model.matrix(object)
- X <- X[,EndoVars,drop=FALSE]
- Z <- model.matrix(object, "instrument")
- fstats <- matrix(ncol=0, nrow=3)
- df1 <- sum(!exoInst)
- for (i in 1:ncol(X))
- {
- resu <- lm(X[,i ]~Z-1)
- v <- switch(vcovType,
- OLS=vcov(resu),
- HC=vcovHC(resu,"HC1"),
- HAC=vcovHAC(resu),
- CL=do.call(vcovCL,c(object at vcovOptions,
- list(x=resu)))
- )
- v <- v[!exoInst,!exoInst]
- b <- coef(resu)[!exoInst]
- f <- b%*%solve(v, b)/df1
- df2 <- resu$df.residual
- fstats <- cbind(fstats, c(f, df1, df2))
- }
- fstats <- rbind(fstats, 1-pf(fstats[1,], fstats[2,],fstats[3,]))
- colnames(fstats) <- colnames(X)
- rownames(fstats) <- c("Stats","df1","df2","pv")
- fstats <- t(fstats)
- mess <- "Instrument strength based on the F-Statistics of the first stage OLS"
+ if (all(!EndoVars)) {
+ fstats <- NULL
+ mess <- "No endogenous variables: no strength measure"
+ }
+ else {
+ X <- model.matrix(object)
+ X <- X[, EndoVars, drop = FALSE]
+ Z <- model.matrix(object, "instrument")
+ fstats <- matrix(ncol = 0, nrow = 3)
+ df1 <- sum(!exoInst)
+ mess <- "Instrument strength based on the F-Statistics of the first stage OLS"
+ addM <- FALSE
+ for (i in 1:ncol(X)) {
+ tmp <- try(getF(i), silent=TRUE)
+ if (inherits(tmp, "try-error"))
+ {
+ fstats <- cbind(fstats, c(NA, NA, NA))
+ addM <- TRUE
+ } else {
+ fstats <- cbind(fstats, tmp)
+ }
}
- list(strength=fstats, mess=mess)
+ if (addM)
+ mess <- paste(mess, "\n",
+ "(Failed to compute some first stage F-statistics)",
+ sep="")
+ fstats <- rbind(fstats, 1 - pf(fstats[1, ], fstats[2,], fstats[3, ]))
+ colnames(fstats) <- colnames(X)
+ rownames(fstats) <- c("Stats", "df1", "df2", "pv")
+ fstats <- t(fstats)
+
+ }
+ list(strength = fstats, mess = mess)
})
### Subsetting models
Modified: pkg/momentfit/R/sgmmfit-methods.R
===================================================================
--- pkg/momentfit/R/sgmmfit-methods.R 2022-12-05 16:06:26 UTC (rev 206)
+++ pkg/momentfit/R/sgmmfit-methods.R 2023-03-10 15:21:26 UTC (rev 207)
@@ -178,7 +178,7 @@
### summary
setMethod("summary","sgmmfit",
- function (object, ...) {
+ function (object, testStrength=TRUE, ...) {
spec <- modelDims(object at model)
eqnNames <- spec$eqnNames
neqn <- length(eqnNames)
@@ -202,10 +202,10 @@
vcovType <- switch(object at model@vcov, HAC = "HAC", iid = "OLS",
MDS = "HC")
strength <- lapply(1:neqn, function(i) {
- if (inherits(object at model, "slinearModel"))
+ if (inherits(object at model, "slinearModel") & testStrength)
momentStrength(object at model[i], par[[i]], vcovType)
else
- NULL})
+ list(strength=NULL, mess=NULL)})
wSpec <- object at wObj@wSpec
ans <- new("summarySysGmm", coef = coef, type = object at type,
specTest = stest, strength = strength, model = object at model,
Modified: pkg/momentfit/man/summary-methods.Rd
===================================================================
--- pkg/momentfit/man/summary-methods.Rd 2022-12-05 16:06:26 UTC (rev 206)
+++ pkg/momentfit/man/summary-methods.Rd 2023-03-10 15:21:26 UTC (rev 207)
@@ -10,15 +10,16 @@
Compute several results from a moment based model fit.
}
\usage{
-\S4method{summary}{gmmfit}(object, \dots)
+\S4method{summary}{gmmfit}(object, testStrength=TRUE, \dots)
\S4method{summary}{gelfit}(object, \dots)
-\S4method{summary}{sgmmfit}(object, \dots)
+\S4method{summary}{sgmmfit}(object, testStrength=TRUE, \dots)
}
\arguments{
\item{object}{A fit object from the package (GMM and GEL are the only
methods for now)}
+ \item{testStrength}{Should the first stage F-statistics be computed?}
\item{\dots}{Other arguments to pass to \code{\link{vcov-methods}}}
}
\section{Methods}{
More information about the Gmm-commits
mailing list