[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