From noreply at r-forge.r-project.org  Fri Mar 10 16:21:26 2023
From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org)
Date: Fri, 10 Mar 2023 16:21:26 +0100 (CET)
Subject: [Gmm-commits] r207 - in pkg: causalOTLSE/R momentfit momentfit/R
	momentfit/man
Message-ID: <20230310152126.ACF7B1806CE@r-forge.r-project.org>

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}{


From noreply at r-forge.r-project.org  Fri Mar 10 16:50:41 2023
From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org)
Date: Fri, 10 Mar 2023 16:50:41 +0100 (CET)
Subject: [Gmm-commits] r208 - pkg/gmm
Message-ID: <20230310155041.7440E183CAA@r-forge.r-project.org>

Author: chaussep
Date: 2023-03-10 16:50:41 +0100 (Fri, 10 Mar 2023)
New Revision: 208

Modified:
   pkg/gmm/DESCRIPTION
Log:
just modified the DESCRIPTION file

Modified: pkg/gmm/DESCRIPTION
===================================================================
--- pkg/gmm/DESCRIPTION	2023-03-10 15:21:26 UTC (rev 207)
+++ pkg/gmm/DESCRIPTION	2023-03-10 15:50:41 UTC (rev 208)
@@ -1,6 +1,6 @@
 Package: gmm
 Version: 1.8
-Date: 2022-07-30
+Date: 2023-03-10
 Title: Generalized Method of Moments and Generalized Empirical
         Likelihood
 Author: Pierre Chausse <pchausse at uwaterloo.ca>