From noreply at r-forge.r-project.org  Tue Sep 19 23:09:27 2023
From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org)
Date: Tue, 19 Sep 2023 23:09:27 +0200 (CEST)
Subject: [Gmm-commits] r214 - in pkg/momentfit: . R man
Message-ID: <20230919210927.C39F8180FF9@r-forge.r-project.org>

Author: chaussep
Date: 2023-09-19 23:09:27 +0200 (Tue, 19 Sep 2023)
New Revision: 214

Modified:
   pkg/momentfit/DESCRIPTION
   pkg/momentfit/R/gelfit-methods.R
   pkg/momentfit/man/confint-methods.Rd
Log:
added a Bartlett correction for intervals on the mean

Modified: pkg/momentfit/DESCRIPTION
===================================================================
--- pkg/momentfit/DESCRIPTION	2023-06-06 15:37:55 UTC (rev 213)
+++ pkg/momentfit/DESCRIPTION	2023-09-19 21:09:27 UTC (rev 214)
@@ -1,6 +1,6 @@
 Package: momentfit
-Version: 0.5
-Date: 2023-06-04
+Version: 0.6
+Date: 2023-09-17
 Title: Methods of Moments
 Author: Pierre Chausse <pchausse at uwaterloo.ca>
 Maintainer: Pierre Chausse <pchausse at uwaterloo.ca>

Modified: pkg/momentfit/R/gelfit-methods.R
===================================================================
--- pkg/momentfit/R/gelfit-methods.R	2023-06-06 15:37:55 UTC (rev 213)
+++ pkg/momentfit/R/gelfit-methods.R	2023-09-19 21:09:27 UTC (rev 214)
@@ -84,10 +84,10 @@
                                             theta0=coef(fit)[-which]))
         }
         test <- specTest(fit2, type=type, ...)@test[1] - test0
-         if (is.null(corr))
-            level - pchisq(test, 1)
-        else
-            level - pchisq(test/corr, 1)
+        crit <- qchisq(level, 1)
+        if (!is.null(corr))
+            crit <- crit/corr
+        crit - test        
     }
     res1 <- try(uniroot(fct, int1, which = which, type=type, level=level,
                         fit=object, test0=test0, corr=corr),
@@ -375,9 +375,19 @@
 setMethod("confint", "numeric",
           function (object, parm, level = 0.95, gelType="EL", 
                     type = c("Wald", "invLR", "invLM", "invJ"),
-                    fact = 3, vcov="iid")
+                    fact = 3, vcov="iid", BartlettCorr = FALSE)
           {
               Call <- try(match.call(call=sys.call(sys.parent())), silent=TRUE)
+              corr <- NULL
+              if (BartlettCorr)
+              {
+                  m <- mean(object)
+                  mu2 <- mean((object-m)^2)
+                  mu3 <- mean((object-m)^3)
+                  mu4 <- mean((object-m)^4)
+                  a <- mu4/(mu2^2*2)-mu3^2/(mu2^3*3)
+                  corr <- (1-a/length(object))
+              }
               if (inherits(Call,"try-error"))
                   Call <- NULL
               type <- match.arg(type)
@@ -391,7 +401,8 @@
               mod <- momentModel(g, ~1, vcov=vcov, data=object)
               fit <- gelFit(model=mod, gelType=gelType,
                             tControl=list(method="Brent",lower=m-s,upper=m+s))
-              ans <- confint(fit, parm=1, level=level, type=type, fact=fact)
+              ans <- confint(fit, parm=1, level=level, type=type,
+                             fact=fact, corr=corr)
               rownames(ans at interval) <- names(object)
               ans
           })
@@ -399,7 +410,7 @@
 setMethod("confint", "data.frame",
           function (object, parm, level = 0.95, gelType="EL", 
                     type = c("Wald", "invLR", "invLM", "invJ"),
-                    fact = 3, vcov="iid", 
+                    fact = 3, corr=NULL, vcov="iid", 
                     npoints=10, cores=4) 
           {
               type <- match.arg(type)
@@ -427,7 +438,7 @@
                                  theta0=theta0)
               fit <- gelFit(mod, gelType=gelType)
               confint(fit, parm=1:2, level=level, lambda=FALSE,
-                      type=type, fact=fact, corr=NULL, vcov=NULL, area=TRUE,
+                      type=type, fact=fact, corr=corr, vcov=NULL, area=TRUE,
                       npoints=npoints, cores=cores)
           })
 
@@ -434,12 +445,12 @@
 setMethod("confint", "matrix",
           function(object, parm, level = 0.95, gelType="EL", 
                     type = c("Wald", "invLR", "invLM", "invJ"),
-                    fact = 3, vcov="iid", 
+                    fact = 3, corr = NULL, vcov="iid", 
                     npoints=10, cores=4)
           {
               object <- as.data.frame(object)
               type <- match.arg(type)
-              confint(object, parm, level, gelType, type, fact, vcov,
+              confint(object, parm, level, gelType, type, fact, corr, vcov,
                       npoints, cores)
           })
                    

Modified: pkg/momentfit/man/confint-methods.Rd
===================================================================
--- pkg/momentfit/man/confint-methods.Rd	2023-06-06 15:37:55 UTC (rev 213)
+++ pkg/momentfit/man/confint-methods.Rd	2023-09-19 21:09:27 UTC (rev 214)
@@ -25,16 +25,16 @@
 
 \S4method{confint}{numeric}(object, parm, level = 0.95, gelType="EL", 
                     type = c("Wald", "invLR", "invLM", "invJ"),
-                    fact = 3, vcov="iid") 
+                    fact = 3, vcov="iid", BartlettCorr = FALSE) 
 
 \S4method{confint}{data.frame}(object, parm, level = 0.95, gelType="EL", 
                     type = c("Wald", "invLR", "invLM", "invJ"),
-                    fact = 3, vcov="iid", npoints=10, 
+                    fact = 3, corr = NULL, vcov="iid", npoints=10, 
                     cores=4) 
 
 \S4method{confint}{matrix}(object, parm, level = 0.95, gelType="EL", 
                     type = c("Wald", "invLR", "invLM", "invJ"),
-                    fact = 3, vcov="iid", npoints=10, 
+                    fact = 3, corr = NULL, vcov="iid", npoints=10, 
                     cores=4) 
 
 \S4method{confint}{ANY}(object, parm, level = 0.95, \dots)
@@ -76,8 +76,12 @@
     region}
 
   \item{area}{If TRUE, a cnnfidence region is computed. The length of
-  \code{"parm"} must be 2 in that case.}
+    \code{"parm"} must be 2 in that case.}
 
+ \item{BartlettCorr}{Should we apply the Bartlett correction proposed by
+ DiCiccio et all (1991). Currently only available for intervals on the mean.
+ }
+
   \item{\dots}{Other arguments to pass to \code{\link{gmmFit}} or
     \code{\link{gelFit}}.}
 }
@@ -111,5 +115,12 @@
 }
 
 }}
+
+\references{
+  DiCiccio, T. and Hall, P. and Romano, J. (1991), Empirical Likelihood
+  is Bartlett Correctable, \emph{The Annals of Statistics}, \bold{19},
+  2, 1053--1061.
+}
+
 \keyword{methods}
 \keyword{Confidence Intervals}