[Distr-commits] r547 - branches/distr-2.2/pkg/distrMod/chm pkg/distrMod pkg/distrMod/R pkg/distrMod/man

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Tue Aug 25 17:17:10 CEST 2009


Author: ruckdeschel
Date: 2009-08-25 17:17:09 +0200 (Tue, 25 Aug 2009)
New Revision: 547

Modified:
   branches/distr-2.2/pkg/distrMod/chm/distrMod.chm
   pkg/distrMod/NAMESPACE
   pkg/distrMod/R/AllClass.R
   pkg/distrMod/R/AllGeneric.R
   pkg/distrMod/R/Confint-class.R
   pkg/distrMod/R/Estimate.R
   pkg/distrMod/R/Estimator.R
   pkg/distrMod/R/MCEstimator.R
   pkg/distrMod/R/MDEstimator.R
   pkg/distrMod/R/MLEstimator.R
   pkg/distrMod/man/Confint-class.Rd
   pkg/distrMod/man/Estimate-class.Rd
Log:
+distrMod: unified treatment of NAs: 
  -class Estimate gains slot completecases, 
  -class Confint gains slot completecases.estimate,
  -there is accessor function completecases[.estimate]
  -slot samplesize only counts complete cases
  -accessor functions samplesize[.estimate] gains argument onlycompletecases;
   if TRUE returns slot samplesize[.estimate] as is, otherwise adds
   sum(completecases[.estimate](object)) to it
  -internally all Estimator functions work with data na.omit(x) instead of x

Modified: branches/distr-2.2/pkg/distrMod/chm/distrMod.chm
===================================================================
(Binary files differ)

Modified: pkg/distrMod/NAMESPACE
===================================================================
--- pkg/distrMod/NAMESPACE	2009-08-25 13:03:33 UTC (rev 546)
+++ pkg/distrMod/NAMESPACE	2009-08-25 15:17:09 UTC (rev 547)
@@ -61,6 +61,7 @@
 exportMethods("locscalename", "LogDeriv")
 exportMethods("coerce", "profile")
 exportMethods("mleCalc", "mceCalc")
+exportMethods("completecases")
 export("distrModMASK")
 export("trafoEst")
 export("PosDefSymmMatrix","PosSemDefSymmMatrix")

Modified: pkg/distrMod/R/AllClass.R
===================================================================
--- pkg/distrMod/R/AllClass.R	2009-08-25 13:03:33 UTC (rev 546)
+++ pkg/distrMod/R/AllClass.R	2009-08-25 15:17:09 UTC (rev 547)
@@ -436,6 +436,7 @@
          representation(name = "character",
                         estimate = "ANY",
                         samplesize = "numeric",
+                        completecases = "logical",
                         asvar = "OptionalNumericOrMatrix",
                         Infos = "matrix",
                         estimate.call = "call",
@@ -447,6 +448,7 @@
          prototype(name = "Estimate",
                    estimate = numeric(0),
                    samplesize = numeric(0),
+                   completecases = logical(0),
                    estimate.call = call("{}"),
                    asvar = NULL,
                    Infos = matrix(c(character(0),character(0)), ncol=2,
@@ -480,6 +482,7 @@
          prototype(name = "Minimum criterion estimate",
                    estimate = numeric(0),
                    samplesize = numeric(0),
+                   completecases = logical(0),
                    asvar = NULL,
                    estimate.call = call("{}"),
                    criterion.fct =  function(){},
@@ -507,6 +510,7 @@
                         call.estimate = "call",
                         name.estimate = "character",
                         samplesize.estimate = "numeric",
+                        completecases.estimate = "logical",
                         trafo.estimate = "list",
                         nuisance.estimate = "OptionalNumeric",
                         fixed.estimate = "OptionalNumeric"
@@ -515,6 +519,7 @@
                    confint = array(0),
                    call.estimate = call("{}"),
                    samplesize.estimate = numeric(0),
+                   completecases.estimate = logical(0),
                    name.estimate = "",
                    trafo.estimate = list(fct = function(x){
                                              list(fval = x, mat = matrix(1))},

Modified: pkg/distrMod/R/AllGeneric.R
===================================================================
--- pkg/distrMod/R/AllGeneric.R	2009-08-25 13:03:33 UTC (rev 546)
+++ pkg/distrMod/R/AllGeneric.R	2009-08-25 15:17:09 UTC (rev 547)
@@ -163,6 +163,9 @@
 if(!isGeneric("fct")){
     setGeneric("fct", function(object) standardGeneric("fct"))
 }
+if(!isGeneric("completecases")){
+    setGeneric("completecases", function(object) standardGeneric("completecases"))
+}
 if(!isGeneric("estimate")){
     setGeneric("estimate", function(object) standardGeneric("estimate"))
 }
@@ -187,6 +190,9 @@
 if(!isGeneric("fixed.estimate")){
     setGeneric("fixed.estimate", function(object,... ) standardGeneric("fixed.estimate"))
 }
+if(!isGeneric("completecases.estimate")){
+    setGeneric("completecases.estimate", function(object) standardGeneric("completecases.estimate"))
+}
 if(!isGeneric("Infos")){
     setGeneric("Infos", function(object) standardGeneric("Infos"))
 }
@@ -203,7 +209,7 @@
     setGeneric("criterion<-", function(object, value) standardGeneric("criterion<-"))
 }
 if(!isGeneric("samplesize")){
-    setGeneric("samplesize", function(object) standardGeneric("samplesize"))
+    setGeneric("samplesize", function(object, ...) standardGeneric("samplesize"))
 }
 if(!isGeneric("asvar")){
     setGeneric("asvar", function(object) standardGeneric("asvar"))

Modified: pkg/distrMod/R/Confint-class.R
===================================================================
--- pkg/distrMod/R/Confint-class.R	2009-08-25 13:03:33 UTC (rev 546)
+++ pkg/distrMod/R/Confint-class.R	2009-08-25 15:17:09 UTC (rev 547)
@@ -5,8 +5,15 @@
            function(object) object at call.estimate)
 setMethod("name.estimate", signature(object="Confint"),
            function(object) object at name.estimate)
+setMethod("completecases.estimate", signature(object="Confint"),
+           function(object) object at completecases.estimate)
+
 setMethod("samplesize.estimate", signature(object="Confint"),
-           function(object) object at samplesize.estimate)
+   function(object, onlycompletecases = TRUE)
+   (object at samplesize.estimate+
+    (1-onlycompletecases)*sum(object at completecases.estimate)))
+
+
 setMethod("nuisance.estimate", signature(object="Confint"),
            function(object) object at nuisance.estimate)
 setMethod("trafo.estimate", signature(object="Confint"),

Modified: pkg/distrMod/R/Estimate.R
===================================================================
--- pkg/distrMod/R/Estimate.R	2009-08-25 13:03:33 UTC (rev 546)
+++ pkg/distrMod/R/Estimate.R	2009-08-25 15:17:09 UTC (rev 547)
@@ -48,7 +48,9 @@
         object 
     })
 
-setMethod("samplesize", "Estimate", function(object) object at samplesize)
+setMethod("samplesize", "Estimate", function(object, onlycompletecases = TRUE)
+   object at samplesize+(1-onlycompletecases)*sum(object at completecases))
+setMethod("completecases", "Estimate", function(object) object at completecases)
 setMethod("asvar", "Estimate", function(object) object at asvar)
 
 setReplaceMethod("asvar", "Estimate", 

Modified: pkg/distrMod/R/Estimator.R
===================================================================
--- pkg/distrMod/R/Estimator.R	2009-08-25 13:03:33 UTC (rev 546)
+++ pkg/distrMod/R/Estimator.R	2009-08-25 15:17:09 UTC (rev 547)
@@ -17,10 +17,12 @@
         colnames(Infos) <- c("method", "message")
     }
 
+    completecases <- complete.cases(x)
+    if(na.rm) x <- na.omit(x)
+    
     samplesize <- if(is.null(dim(x))) length(x) else dim(x)[2]
 
 
-    if(na.rm) x <- complete.cases(x)
     estimate <- estimator(x, ...)
     
     l.e <- length(estimate)
@@ -37,6 +39,7 @@
     res at estimate.call <- es.call
     res at name <- name
     res at Infos <- Infos
+    res at completecases <- completecases
     
     if(missing(nuis.idx)) res at nuis.idx <- NULL
     else res at nuis.idx <- nuis.idx

Modified: pkg/distrMod/R/MCEstimator.R
===================================================================
--- pkg/distrMod/R/MCEstimator.R	2009-08-25 13:03:33 UTC (rev 546)
+++ pkg/distrMod/R/MCEstimator.R	2009-08-25 15:17:09 UTC (rev 547)
@@ -10,6 +10,8 @@
     es.call <- match.call()
     dots <- match.call(expand.dots = FALSE)$"..."
 
+    completecases <- complete.cases(x)
+    if(na.rm) x <- na.omit(x)
 
     ## some checking
     if(!is.numeric(x))
@@ -19,9 +21,7 @@
     if(!is.function(criterion))
       stop(gettext("'criterion' has to be a function"))
 
-    if(na.rm) x <- complete.cases(x)
 
-
     ## manipulation of the arg list to method mceCalc
     argList <- c(list(x = x, PFam = ParamFamily, criterion = criterion, 
                    startPar = startPar, penalty = penalty))
@@ -50,6 +50,7 @@
     
     ## digesting the results of mceCalc
     res <- do.call(.process.meCalcRes, argList)
+    res at completecases <- completecases
 
     return(res)
 }

Modified: pkg/distrMod/R/MDEstimator.R
===================================================================
--- pkg/distrMod/R/MDEstimator.R	2009-08-25 13:03:33 UTC (rev 546)
+++ pkg/distrMod/R/MDEstimator.R	2009-08-25 15:17:09 UTC (rev 547)
@@ -10,6 +10,8 @@
     es.call <- match.call()
     dots <- match.call(expand.dots = FALSE)$"..."
 
+    completecases <- complete.cases(x)
+    if(na.rm) x <- na.omit(x)
 
     ## some checking
     if(!is.numeric(x))
@@ -18,9 +20,7 @@
     if(missing(dist.name))
       dist.name <- names(distance(x, ParamFamily at distribution))
 
-    if(na.rm) x <- complete.cases(x)
 
-
     ## manipulation of the arg list to method mceCalc
     argList <- c(list(x = x, PFam = ParamFamily, criterion = distance, 
                    startPar = startPar, penalty = penalty, 
@@ -48,6 +48,7 @@
     ## digesting the results of mceCalc
     res <- do.call(.process.meCalcRes, argList)
 
+    res at completecases <- completecases
     return(res)
 }
 

Modified: pkg/distrMod/R/MLEstimator.R
===================================================================
--- pkg/distrMod/R/MLEstimator.R	2009-08-25 13:03:33 UTC (rev 546)
+++ pkg/distrMod/R/MLEstimator.R	2009-08-25 15:17:09 UTC (rev 547)
@@ -12,14 +12,16 @@
     dots <- match.call(expand.dots = FALSE)$"..."
 
 
+    completecases <- complete.cases(x)
+    if(na.rm) x <- na.omit(x)
+
+
     ## some checking
     if(!is.numeric(x))
       stop(gettext("'x' has to be a numeric vector"))   
     if(is.null(startPar)) startPar <- startPar(ParamFamily)(x,...)
 
 
-    if(na.rm) x <- complete.cases(x)
-
     ## manipulation of the arg list to method mceCalc
     argList <- c(list(x = x, PFam = ParamFamily, startPar = startPar, 
                       penalty = penalty))
@@ -48,7 +50,8 @@
     names(res at criterion) <- "negative log-likelihood"
     res at estimate.call <- es.call
     res at name <- "Maximum likelihood estimate"
-    
+    res at completecases <- completecases
+
     return(res)
 }
 

Modified: pkg/distrMod/man/Confint-class.Rd
===================================================================
--- pkg/distrMod/man/Confint-class.Rd	2009-08-25 13:03:33 UTC (rev 546)
+++ pkg/distrMod/man/Confint-class.Rd	2009-08-25 15:17:09 UTC (rev 547)
@@ -11,6 +11,8 @@
 \alias{trafo.estimate,Confint-method}
 \alias{samplesize.estimate}
 \alias{samplesize.estimate,Confint-method}
+\alias{completecases.estimate}
+\alias{completecases.estimate,Confint-method}
 \alias{nuisance.estimate}
 \alias{nuisance.estimate,Confint-method}
 \alias{fixed.estimate}
@@ -40,7 +42,10 @@
     \item{\code{name.estimate}:}{Object of class \code{"character"}:
       the name of the estimate(s) for which the confidence intervals are produced.}
     \item{\code{samplesize.estimate}:}{Object of class \code{"numeric"}:
-      the sample size of the estimate(s) for which the confidence intervals are produced.}
+      the sample size of the estimate(s) for which the confidence intervals
+      are (only complete cases) produced.}
+    \item{\code{completecases.estimate}:}{Object of class \code{"logical"}:
+         complete cases at which the estimate was evaluated. }
     \item{\code{trafo.estimate}:}{Object of class \code{"matrix"}:
       the trafo/derivative matrix of the estimate(s) for which 
       the confidence intervals are produced.}
@@ -70,9 +75,16 @@
       accessor function for slot \code{trafo.estimate}. }
 
     \item{samplesize.estimate}{\code{signature(object = "Confint")}: 
-      accessor function for slot \code{samplesize.estimate}. }
+      (with additional argument \code{onlycompletecases}
+      defaulting to \code{TRUE} returns the sample size;
+      in case there are any incomplete cases and argument
+      \code{onlycompletecases} is \code{FALSE}, the number of
+      these is added to slot \code{samplesize}. }
 
-    \item{nuisance.estimate}{\code{signature(object = "Confint")}: 
+    \item{completecases.estimate}{\code{signature(object = "Confint")}:
+      accessor function for slot \code{completecases.estimate}. }
+
+    \item{nuisance.estimate}{\code{signature(object = "Confint")}:
       accessor function for slot \code{nuisance.estimate}. }
 
     \item{fixed.estimate}{\code{signature(object = "Confint")}: 

Modified: pkg/distrMod/man/Estimate-class.Rd
===================================================================
--- pkg/distrMod/man/Estimate-class.Rd	2009-08-25 13:03:33 UTC (rev 546)
+++ pkg/distrMod/man/Estimate-class.Rd	2009-08-25 15:17:09 UTC (rev 547)
@@ -11,6 +11,8 @@
 \alias{Infos,Estimate-method}
 \alias{samplesize}
 \alias{samplesize,Estimate-method}
+\alias{completecases}
+\alias{completecases,Estimate-method}
 \alias{asvar}
 \alias{asvar,Estimate-method}
 \alias{fixed,Estimate-method}
@@ -50,8 +52,11 @@
     \item{\code{asvar}:}{ object of class \code{"OptionalNumericOrMatrix"}
       which may contain the asymptotic (co)variance of the estimator. }
     \item{\code{samplesize}:}{ object of class \code{"numeric"} ---
-      the samplesize at which the estimate was evaluated. }
-    \item{\code{nuis.idx}:}{ object of class \code{"OptionalNumeric"}: 
+      the samplesize (only complete cases are counted)
+      at which the estimate was evaluated. }
+    \item{\code{completecases}:}{ object of class \code{"logical"} ---
+         complete cases at which the estimate was evaluated. }
+    \item{\code{nuis.idx}:}{ object of class \code{"OptionalNumeric"}:
      indices of \code{estimate} belonging to the nuisance part}
     \item{\code{fixed}:}{ object of class \code{"OptionalNumeric"}: 
      the fixed and known part of the parameter}
@@ -82,9 +87,16 @@
       accessor function for slot \code{estimate.call}. }
 
     \item{samplesize}{\code{signature(object = "Estimate")}: 
-      accessor function for slot \code{samplesize}. }
+      (with additional argument \code{onlycompletecases}
+      defaulting to \code{TRUE} returns the sample size;
+      in case there are any incomplete cases and argument
+      \code{onlycompletecases} is \code{FALSE}, the number of
+      these is added to slot \code{samplesize}. }
 
-    \item{asvar}{\code{signature(object = "Estimate")}: 
+    \item{completecases}{\code{signature(object = "Estimate")}:
+      accessor function for slot \code{completecases}. }
+
+    \item{asvar}{\code{signature(object = "Estimate")}:
       accessor function for slot \code{asvar}. }
 
     \item{asvar<-}{\code{signature(object = "Estimate")}: 



More information about the Distr-commits mailing list