[Distr-commits] r932 - in branches/distr-2.6/pkg/distrMod: R man

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Wed Apr 9 23:18:09 CEST 2014


Author: ruckdeschel
Date: 2014-04-09 23:18:09 +0200 (Wed, 09 Apr 2014)
New Revision: 932

Modified:
   branches/distr-2.6/pkg/distrMod/R/MLEstimator.R
   branches/distr-2.6/pkg/distrMod/R/internalMleCalc.R
   branches/distr-2.6/pkg/distrMod/R/mleCalc-methods.R
   branches/distr-2.6/pkg/distrMod/man/MLEstimator.Rd
   branches/distr-2.6/pkg/distrMod/man/internalmleHelpers.Rd
   branches/distr-2.6/pkg/distrMod/man/mleCalc-methods.Rd
Log:
distrMod: introduced dropZeroDensity argument to ML estimators 

Modified: branches/distr-2.6/pkg/distrMod/R/MLEstimator.R
===================================================================
--- branches/distr-2.6/pkg/distrMod/R/MLEstimator.R	2014-04-02 22:48:27 UTC (rev 931)
+++ branches/distr-2.6/pkg/distrMod/R/MLEstimator.R	2014-04-09 21:18:09 UTC (rev 932)
@@ -7,7 +7,8 @@
 MLEstimator <- function(x, ParamFamily, startPar = NULL, 
                         Infos, trafo = NULL, penalty = 1e20,
                         validity.check = TRUE, na.rm = TRUE,
-                        ..., .withEvalAsVar = TRUE){
+                        ..., .withEvalAsVar = TRUE,
+                        dropZeroDensity = TRUE){
 
     ## preparation: getting the matched call
     es.call <- match.call()
@@ -24,12 +25,12 @@
 
     ## manipulation of the arg list to method mceCalc
     argList <- c(list(x = x, PFam = ParamFamily, startPar = startPar, 
-                      penalty = penalty))
+                      penalty = penalty, dropZeroDensity = dropZeroDensity ))
 
+    if(missing(Infos))      Infos <- NULL
+        argList <- c(argList, Infos = Infos)
     if(missing(validity.check)) validity.check <- TRUE
        argList$validity.check <- validity.check
-    if(missing(Infos))      Infos <- NULL
-        argList <- c(argList, Infos = Infos)
     if(!is.null(dots))      argList <- c(argList, dots)
 
     ## call to mleCalc
@@ -42,7 +43,8 @@
     
     argList <- list(res0, PFam = ParamFamily, trafo = trafo,
                       res.name = "Maximum likelihood estimate",
-                      call = quote(es.call), .withEvalAsVar=.withEvalAsVar)
+                      call = quote(es.call), .withEvalAsVar=.withEvalAsVar,
+                      check.validity = validity.check )
 
     if(!is.null(asv))   argList <- c(argList, asvar.fct = asv)
     if(!is.null(dots))  argList <- c(argList, dots)

Modified: branches/distr-2.6/pkg/distrMod/R/internalMleCalc.R
===================================================================
--- branches/distr-2.6/pkg/distrMod/R/internalMleCalc.R	2014-04-02 22:48:27 UTC (rev 931)
+++ branches/distr-2.6/pkg/distrMod/R/internalMleCalc.R	2014-04-09 21:18:09 UTC (rev 932)
@@ -2,14 +2,17 @@
 #################### m[l,c]eCalc
 
 ### not exported:
-.negLoglikelihood <- function(x, Distribution, ...){
+.negLoglikelihood <- function(x, Distribution, ..., dropZeroDensity = TRUE){
            dots <- list(...)
            dots$thetaPar <- NULL
           ### increase accuracy:
            if(Distribution at .withSim||!.inArgs("log",d(Distribution)))
-               res <- -sum(log(do.call(Distribution at d,args = c(list(x),dots) )))
+               res0 <- log(do.call(Distribution at d,args = c(list(x),dots) ))
            else
-               res <- -sum(do.call(Distribution at d,args = c(list(x,log = TRUE), dots) ))
+               res0 <- do.call(Distribution at d,args = c(list(x,log = TRUE), dots) )
+           m <- -min(res0[is.finite(res0)])*1e20
+           if(dropZeroDensity) res0 <- res0[is.finite(res0)]-sum(res0==-Inf)*max(m,1e200)
+           res <- -sum(res0,na.rm=TRUE)
            return(res)
     }
 

Modified: branches/distr-2.6/pkg/distrMod/R/mleCalc-methods.R
===================================================================
--- branches/distr-2.6/pkg/distrMod/R/mleCalc-methods.R	2014-04-02 22:48:27 UTC (rev 931)
+++ branches/distr-2.6/pkg/distrMod/R/mleCalc-methods.R	2014-04-09 21:18:09 UTC (rev 932)
@@ -64,11 +64,22 @@
 
 
 setMethod("mleCalc", signature(x = "numeric", PFam = "ParamFamily"),
-           function(x, PFam, startPar = NULL, penalty = 1e20, Infos  = NULL,
+           function(x, PFam, startPar = NULL, penalty = 1e20,
+                    dropZeroDensity = TRUE, Infos  = NULL,
                     validity.check = TRUE, ...){
 
+           if(dropZeroDensity){
+              .negLoglikelihood0 <- function(x, Distribution, ...)
+                          .negLoglikelihood(x, Distribution, ...,
+                                            dropZeroDensity = TRUE)
+           }else{
+              .negLoglikelihood0 <- function(x, Distribution, ...)
+                          .negLoglikelihood(x, Distribution, ...,
+                                            dropZeroDensity = FALSE)
+           }
+
            res <- mceCalc(x = x, PFam = PFam, 
-                          criterion = .negLoglikelihood, startPar = startPar, 
+                          criterion = .negLoglikelihood0, startPar = startPar,
                           penalty = penalty, crit.name = "neg.Loglikelihood",
                           Infos = Infos, validity.check = validity.check, ...)
            names(res$criterion) <- "neg.Loglikelihood"

Modified: branches/distr-2.6/pkg/distrMod/man/MLEstimator.Rd
===================================================================
--- branches/distr-2.6/pkg/distrMod/man/MLEstimator.Rd	2014-04-02 22:48:27 UTC (rev 931)
+++ branches/distr-2.6/pkg/distrMod/man/MLEstimator.Rd	2014-04-09 21:18:09 UTC (rev 932)
@@ -12,7 +12,7 @@
 MLEstimator(x, ParamFamily, startPar = NULL, 
             Infos, trafo = NULL, penalty = 1e20,
             validity.check = TRUE, na.rm = TRUE, ...,
-            .withEvalAsVar = TRUE)
+            .withEvalAsVar = TRUE, dropZeroDensity = TRUE)
 }
 %- maybe also 'usage' for other objects documented here.
 \arguments{
@@ -36,6 +36,9 @@
   \item{.withEvalAsVar}{logical: shall slot \code{asVar} be evaluated
                    (if \code{asvar.fct} is given) or
                    just the call be returned?}
+  \item{dropZeroDensity}{logical of length 1; shall observations with
+     density zero be dropped? Optimizers like \code{optim} require finite
+     values, so get problems when negative loglikelihood is evaluated. }
 }
 \details{
   The function uses \code{\link{mleCalc}}

Modified: branches/distr-2.6/pkg/distrMod/man/internalmleHelpers.Rd
===================================================================
--- branches/distr-2.6/pkg/distrMod/man/internalmleHelpers.Rd	2014-04-02 22:48:27 UTC (rev 931)
+++ branches/distr-2.6/pkg/distrMod/man/internalmleHelpers.Rd	2014-04-09 21:18:09 UTC (rev 932)
@@ -13,7 +13,7 @@
 \code{MLEstimator} in package ``distrMod''.}
 
 \usage{
-.negLoglikelihood(x, Distribution, ...)
+.negLoglikelihood(x, Distribution, ..., dropZeroDensity = TRUE)
 .process.meCalcRes(res, PFam, trafo, res.name, call, asvar.fct, check.validity,
                    ..., .withEvalAsVar = TRUE)
 .callParamFamParameter(PFam, theta, idx, nuis, fixed)
@@ -44,6 +44,9 @@
   \item{.withEvalAsVar}{logical: shall slot \code{asVar} be evaluated
                    (if \code{asvar.fct} is given) or
                    just the call be returned?}
+  \item{dropZeroDensity}{logical of length 1; shall observations with
+     density zero be dropped? Optimizers like \code{optim} require finite
+     values, so get problems when negative loglikelihood is evaluated. }
 }
 
 \details{

Modified: branches/distr-2.6/pkg/distrMod/man/mleCalc-methods.Rd
===================================================================
--- branches/distr-2.6/pkg/distrMod/man/mleCalc-methods.Rd	2014-04-02 22:48:27 UTC (rev 931)
+++ branches/distr-2.6/pkg/distrMod/man/mleCalc-methods.Rd	2014-04-09 21:18:09 UTC (rev 932)
@@ -23,7 +23,7 @@
                    Infos = NULL, validity.check = TRUE,
                    withthetaPar = FALSE,\dots)
 \S4method{mleCalc}{numeric,ParamFamily}(x, PFam, startPar = NULL, 
-                   penalty = 1e20, Infos = NULL,
+                   penalty = 1e20, dropZeroDensity = TRUE, Infos = NULL,
                     validity.check = TRUE, \dots)
 \S4method{mleCalc}{numeric,BinomFamily}(x, PFam, \dots)
 \S4method{mleCalc}{numeric,PoisFamily}(x, PFam, \dots)
@@ -46,6 +46,9 @@
                may be missing}
   \item{validity.check}{logical: shall return parameter value be checked for
     validity?}
+  \item{dropZeroDensity}{logical of length 1; shall observations with
+     density zero be dropped? Optimizers like \code{optim} require finite
+     values, so get problems when negative loglikelihood is evaluated. }
   \item{\dots}{additional argument(s) for \code{optim} / \code{optimize}}
 }
 \value{



More information about the Distr-commits mailing list