[Distr-commits] r520 - in branches/distr-2.2/pkg: distrEx/R distrEx/chm distrMod distrMod/R distrMod/chm distrMod/man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Tue Aug 4 07:14:24 CEST 2009
Author: ruckdeschel
Date: 2009-08-04 07:14:21 +0200 (Tue, 04 Aug 2009)
New Revision: 520
Modified:
branches/distr-2.2/pkg/distrEx/R/Expectation.R
branches/distr-2.2/pkg/distrEx/chm/distrEx.chm
branches/distr-2.2/pkg/distrMod/NAMESPACE
branches/distr-2.2/pkg/distrMod/R/AllClass.R
branches/distr-2.2/pkg/distrMod/R/AllGeneric.R
branches/distr-2.2/pkg/distrMod/R/Estimate.R
branches/distr-2.2/pkg/distrMod/R/MDEstimator.R
branches/distr-2.2/pkg/distrMod/R/internalMleCalc.R
branches/distr-2.2/pkg/distrMod/R/mleCalc-methods.R
branches/distr-2.2/pkg/distrMod/chm/00Index.html
branches/distr-2.2/pkg/distrMod/chm/MCEstimate-class.html
branches/distr-2.2/pkg/distrMod/chm/MCEstimator.html
branches/distr-2.2/pkg/distrMod/chm/MDEstimator.html
branches/distr-2.2/pkg/distrMod/chm/distrMod.chm
branches/distr-2.2/pkg/distrMod/chm/distrMod.toc
branches/distr-2.2/pkg/distrMod/chm/meRes.html
branches/distr-2.2/pkg/distrMod/chm/mleCalc-methods.html
branches/distr-2.2/pkg/distrMod/man/MCEstimate-class.Rd
branches/distr-2.2/pkg/distrMod/man/MCEstimator.Rd
branches/distr-2.2/pkg/distrMod/man/MDEstimator.Rd
branches/distr-2.2/pkg/distrMod/man/meRes.Rd
branches/distr-2.2/pkg/distrMod/man/mleCalc-methods.Rd
Log:
distrEx:
+ Expectation for GPareto now has IQR.fac accuracy set to max(1e4,getdistrExOption("IQR.fac") to enhance accuracy for integration;
distrMod:
+ class MCEstimate gains slot optimwarn to gather warnings issued in optimization; may be assessed with method optimwarn()
+ potentially, mleCalc now transports the value of the current parameter value theta as argument thetaPar to the optimization criterion;
controlled for by argument withthetaPar (defaulting to FALSE)
Hence, if desired, particular criterion functions could make use of this information, by, say
computing the criterion differently for different parameter values
We used it to check whether the numerically found optimum obeys first order conditions (i.e. sum (L2deriv(x_i))=0)
+ for MDEstimator, similarly, this is controlled by paramDepDist
Modified: branches/distr-2.2/pkg/distrEx/R/Expectation.R
===================================================================
--- branches/distr-2.2/pkg/distrEx/R/Expectation.R 2009-07-31 21:58:15 UTC (rev 519)
+++ branches/distr-2.2/pkg/distrEx/R/Expectation.R 2009-08-04 05:14:21 UTC (rev 520)
@@ -803,7 +803,7 @@
rel.tol= getdistrExOption("ErelativeTolerance"),
lowerTruncQuantile = getdistrExOption("ElowerTruncQuantile"),
upperTruncQuantile = getdistrExOption("EupperTruncQuantile"),
- IQR.fac = getdistrExOption("IQR.fac"), ...
+ IQR.fac = max(1e4,getdistrExOption("IQR.fac")), ...
){
dots <- list(...)
Modified: branches/distr-2.2/pkg/distrEx/chm/distrEx.chm
===================================================================
(Binary files differ)
Modified: branches/distr-2.2/pkg/distrMod/NAMESPACE
===================================================================
--- branches/distr-2.2/pkg/distrMod/NAMESPACE 2009-07-31 21:58:15 UTC (rev 519)
+++ branches/distr-2.2/pkg/distrMod/NAMESPACE 2009-08-04 05:14:21 UTC (rev 520)
@@ -47,7 +47,7 @@
"name.estimate", "trafo.estimate", "nuisance.estimate",
"fixed.estimate", "Infos", "Infos<-", "addInfo<-",
"criterion", "criterion<-", "criterion.fct", "method",
- "samplesize", "asvar", "asvar<-")
+ "samplesize", "asvar", "asvar<-", "optimwarn")
exportMethods("untransformed.estimate", "untransformed.asvar")
exportMethods("confint")
exportMethods("nuisance", "main")
Modified: branches/distr-2.2/pkg/distrMod/R/AllClass.R
===================================================================
--- branches/distr-2.2/pkg/distrMod/R/AllClass.R 2009-07-31 21:58:15 UTC (rev 519)
+++ branches/distr-2.2/pkg/distrMod/R/AllClass.R 2009-08-04 05:14:21 UTC (rev 520)
@@ -417,7 +417,8 @@
setClass("MCEstimate",
representation(criterion = "numeric",
criterion.fct = "function",
- method = "character"),
+ method = "character",
+ optimwarn = "character"),
prototype(name = "Minimum criterion estimate",
estimate = numeric(0),
samplesize = numeric(0),
@@ -431,7 +432,8 @@
nuis.idx = NULL,
trafo = list(fct = function(x){
list(fval = x, mat = matrix(1))},
- mat = matrix(1))
+ mat = matrix(1)),
+ optimwarn = ""
),
contains = "Estimate")
Modified: branches/distr-2.2/pkg/distrMod/R/AllGeneric.R
===================================================================
--- branches/distr-2.2/pkg/distrMod/R/AllGeneric.R 2009-07-31 21:58:15 UTC (rev 519)
+++ branches/distr-2.2/pkg/distrMod/R/AllGeneric.R 2009-08-04 05:14:21 UTC (rev 520)
@@ -269,3 +269,6 @@
if(!isGeneric("method")){
setGeneric("method", function(object) standardGeneric("method"))
}
+if(!isGeneric("optimwarn")){
+ setGeneric("optimwarn", function(object) standardGeneric("optimwarn"))
+}
Modified: branches/distr-2.2/pkg/distrMod/R/Estimate.R
===================================================================
--- branches/distr-2.2/pkg/distrMod/R/Estimate.R 2009-07-31 21:58:15 UTC (rev 519)
+++ branches/distr-2.2/pkg/distrMod/R/Estimate.R 2009-08-04 05:14:21 UTC (rev 520)
@@ -65,6 +65,7 @@
setMethod("untransformed.asvar", "Estimate", function(object)
object at untransformed.asvar)
+setMethod("optimwarn", "MCEstimate", function(object) object at optimwarn)
setMethod("criterion", "MCEstimate", function(object) object at criterion)
setMethod("criterion.fct", "MCEstimate", function(object) object at criterion.fct)
setMethod("method", "MCEstimate", function(object) object at method)
Modified: branches/distr-2.2/pkg/distrMod/R/MDEstimator.R
===================================================================
--- branches/distr-2.2/pkg/distrMod/R/MDEstimator.R 2009-07-31 21:58:15 UTC (rev 519)
+++ branches/distr-2.2/pkg/distrMod/R/MDEstimator.R 2009-08-04 05:14:21 UTC (rev 520)
@@ -1,15 +1,14 @@
###############################################################################
## Implementation of minimum distance estimation
###############################################################################
-MDEstimator <- function(x, ParamFamily, distance = KolmogorovDist, dist.name,
+MDEstimator <- function(x, ParamFamily, distance = KolmogorovDist,
+ dist.name, paramDepDist = FALSE,
startPar = NULL, Infos,
trafo = NULL, penalty = 1e20, asvar.fct, ...){
## preparation: getting the matched call
es.call <- match.call()
dots <- match.call(expand.dots = FALSE)$"..."
-
-
## some checking
if(!is.numeric(x))
stop(gettext("'x' has to be a numeric vector"))
@@ -17,20 +16,17 @@
if(missing(dist.name))
dist.name <- names(distance(x, ParamFamily at distribution))
+ if(paramDepDist) dots$thetaPar <-NULL
-
## manipulation of the arg list to method mceCalc
- argList <- c(list(x = x, PFam = ParamFamily, criterion = distance,
+ argList <- c(list(x = x, PFam = ParamFamily, criterion = distance,
startPar = startPar, penalty = penalty,
- crit.name = dist.name))
+ crit.name = dist.name, withthetaPar = paramDepDist))
if(missing(Infos)) Infos <- NULL
argList <- c(argList, Infos = Infos)
if(!is.null(dots)) argList <- c(argList, dots)
-
-
## call to mceCalc
res0 <- do.call(mceCalc, argList)
-
## digesting the results of mceCalc
names(res0$criterion) <- dist.name
Modified: branches/distr-2.2/pkg/distrMod/R/internalMleCalc.R
===================================================================
--- branches/distr-2.2/pkg/distrMod/R/internalMleCalc.R 2009-07-31 21:58:15 UTC (rev 519)
+++ branches/distr-2.2/pkg/distrMod/R/internalMleCalc.R 2009-08-04 05:14:21 UTC (rev 520)
@@ -3,11 +3,13 @@
### not exported:
.negLoglikelihood <- function(x, Distribution, ...){
+ dots <- list(...)
+ dots$thetaPar <- NULL
### increase accuracy:
if(Distribution at .withSim||!.inArgs("log",d(Distribution)))
- res <- -sum(log(Distribution at d(x, ...)))
+ res <- -sum(log(do.call(Distribution at d,args = c(list(x),dots) )))
else
- res <- -sum(Distribution at d(x, log = TRUE, ...))
+ res <- -sum(do.call(Distribution at d,args = c(list(x,log = TRUE), dots) ))
return(res)
}
@@ -103,7 +105,7 @@
untransformed.estimate = untransformed.estimate,
untransformed.asvar = untransformed.asvar,
criterion.fct = res$crit.fct, method = res$method,
- fixed = fixed(param))
+ fixed = fixed(param), optimwarn = res$warns)
return(res.me)
}
Modified: branches/distr-2.2/pkg/distrMod/R/mleCalc-methods.R
===================================================================
--- branches/distr-2.2/pkg/distrMod/R/mleCalc-methods.R 2009-07-31 21:58:15 UTC (rev 519)
+++ branches/distr-2.2/pkg/distrMod/R/mleCalc-methods.R 2009-08-04 05:14:21 UTC (rev 520)
@@ -13,11 +13,11 @@
meRes <- function(x, estimate, criterion.value, param, crit.fct,
method = "explicit solution",
- crit.name = "Maximum Likelihood", Infos)
+ crit.name = "Maximum Likelihood", Infos, warns = "")
return(list(estimate = estimate, criterion = criterion.value,
param = param, crit.fct = crit.fct, method = method,
crit.name = crit.name, Infos = Infos,
- samplesize = samplesize(x)))
+ samplesize = samplesize(x), warns=warns))
get.criterion.fct <- function(theta, Data, ParamFam, criterion.ff, fun, ...){
@@ -78,15 +78,16 @@
setMethod("mceCalc", signature(x = "numeric", PFam = "ParamFamily"),
function(x, PFam, criterion, startPar = NULL, penalty = 1e20,
- crit.name = "", Infos = NULL, ...){
+ crit.name = "", Infos = NULL, withthetaPar = FALSE, ...){
+
if(is.null(startPar)) startPar <- startPar(PFam)(x,...)
lmx <- length(main(PFam))
lnx <- length(nuisance(PFam))
fixed <- fixed(PFam)
-
+ allwarns <<- character(0)
fun <- function(theta, Data, ParamFamily, criterionF, ...){
vP <- validParameter(ParamFamily, theta)
dots <- list(...)
@@ -102,13 +103,26 @@
else names(theta) <- names(main(ParamFamily))
distr.new <- try(ParamFamily at modifyParam(theta), silent = TRUE)
argList <- c(list(Data, distr.new), dots)
- if(is(distr.new,"try.error"))
- crit0 <- penalty
- else{
- crit0 <- try(do.call(what = criterionF, args = argList),
+ if(withthetaPar) argList <- c(argList, list(thetaPar = theta))
+ if(is(distr.new,"try.error")){
+ crit0 <- penalty
+ warn0 <- paste("Parameter transformation at theta = ",
+ paste(round(theta,3),collapse=","),
+ " threw an error;\n", "returning starting par;\n",
+ sep="")
+ allwarns <<- c(allwarns,warn0)
+ warning(warn0)
+ }else{crit0 <- try(do.call(what = criterionF, args = argList),
silent = TRUE)
- if(is(crit0, "try-error"))
- crit0 <- penalty
+ if(is(crit0, "try-error")){
+ crit0 <- penalty
+ warn1 <- paste("Criterion evaluation at theta = ",
+ paste(round(theta,3),collapse=","),
+ " threw an error;\n", "returning starting par;\n",
+ sep="")
+ allwarns <<- c(allwarns,warn1)
+ warning(warn1)
+ }
}
}
critP <- crit0 + penalty * (1-vP)
@@ -123,8 +137,8 @@
method <- "optimize"
}else{
if(is(startPar,"Estimate")) startPar <- untransformed.estimate(startPar)
- res <- optim(par = startPar, fn = fun, Data = x, ParamFamily = PFam,
- criterionF = criterion, ...)
+ res <- optim(par = startPar, fn = fun, Data = x,
+ ParamFamily = PFam, criterionF = criterion, ...)
theta <- as.numeric(res$par)
names(theta) <- c(names(main(PFam)),names(nuisance(PFam)))
method <- "optim"
@@ -157,7 +171,7 @@
criterion.ff = criterion, fun2, ...)
return(meRes(x, theta, crit, param, crit.fct, method = method,
- crit.name = crit.name, Infos = Infos))
+ crit.name = crit.name, Infos = Infos, warns= allwarns))
})
################################################################################
Modified: branches/distr-2.2/pkg/distrMod/chm/00Index.html
===================================================================
--- branches/distr-2.2/pkg/distrMod/chm/00Index.html 2009-07-31 21:58:15 UTC (rev 519)
+++ branches/distr-2.2/pkg/distrMod/chm/00Index.html 2009-08-04 05:14:21 UTC (rev 520)
@@ -556,6 +556,10 @@
<td>Class for Odd Functions</td></tr>
<tr><td width="25%"><a href="onesidedBias-class.html">onesidedBias-class</a></td>
<td>onesided Bias Type</td></tr>
+<tr><td width="25%"><a href="MCEstimate-class.html">optimwarn</a></td>
+<td>MCEstimate-class.</td></tr>
+<tr><td width="25%"><a href="MCEstimate-class.html">optimwarn,MCEstimate-method</a></td>
+<td>MCEstimate-class.</td></tr>
</table>
<h2><a name="P">-- P --</a></h2>
Modified: branches/distr-2.2/pkg/distrMod/chm/MCEstimate-class.html
===================================================================
--- branches/distr-2.2/pkg/distrMod/chm/MCEstimate-class.html 2009-07-31 21:58:15 UTC (rev 519)
+++ branches/distr-2.2/pkg/distrMod/chm/MCEstimate-class.html 2009-08-04 05:14:21 UTC (rev 520)
@@ -11,7 +11,9 @@
<param name="keyword" value="R: criterion.fct">
<param name="keyword" value="R: criterion.fct,MCEstimate-method">
<param name="keyword" value="R: method">
+<param name="keyword" value="R: optimwarn">
<param name="keyword" value="R: method,MCEstimate-method">
+<param name="keyword" value="R: optimwarn,MCEstimate-method">
<param name="keyword" value="R: criterion<-">
<param name="keyword" value="R: criterion<-,MCEstimate-method">
<param name="keyword" value="R: coerce,MCEstimate,mle-method">
@@ -65,6 +67,8 @@
<dt><code>Infos</code>:</dt><dd>object of class <code>"matrix"</code>
with two columns named <code>method</code> and <code>message</code>:
additional informations. </dd>
+<dt><code>optimwarn</code>:</dt><dd>object of class <code>"character"</code>
+warnings issued during optimization. </dd>
<dt><code>asvar</code>:</dt><dd>object of class <code>"OptionalMatrix"</code>
which may contain the asymptotic (co)variance of the estimator. </dd>
<dt><code>samplesize</code>:</dt><dd>object of class <code>"numeric"</code> —
@@ -96,7 +100,11 @@
replacement function for slot <code>criterion</code>. </dd>
-<dt>criterion.fct</dt><dd><code>signature(object = "MCEstimate")</code>:
+<dt>optimwarn</dt><dd><code>signature(object = "MCEstimate")</code>:
+accessor function for slot <code>optimwarn</code>. </dd>
+
+
+<dt>criterion.fct</dt><dd><code>signature(object = "MCEstimate")</code>:
accessor function for slot <code>criterion.fct</code>. </dd>
Modified: branches/distr-2.2/pkg/distrMod/chm/MCEstimator.html
===================================================================
--- branches/distr-2.2/pkg/distrMod/chm/MCEstimator.html 2009-07-31 21:58:15 UTC (rev 519)
+++ branches/distr-2.2/pkg/distrMod/chm/MCEstimator.html 2009-08-04 05:14:21 UTC (rev 520)
@@ -101,6 +101,17 @@
An object of S4-class <code>"MCEstimate"</code> which inherits from class
<code>"Estimate"</code>.</p>
+<h3>Note</h3>
+
+<p>
+The criterion function gets called together with a parameter <code>thetaPar</code>
+which is the current parameter value under consideration, i.e.; the value
+under which the model distribution is considered. Hence, if desired,
+particular criterion functions could make use of this information, by, say
+computing the criterion differently for different parameter values.
+</p>
+
+
<h3>Author(s)</h3>
<p>
Modified: branches/distr-2.2/pkg/distrMod/chm/MDEstimator.html
===================================================================
--- branches/distr-2.2/pkg/distrMod/chm/MDEstimator.html 2009-07-31 21:58:15 UTC (rev 519)
+++ branches/distr-2.2/pkg/distrMod/chm/MDEstimator.html 2009-08-04 05:14:21 UTC (rev 520)
@@ -25,7 +25,7 @@
<pre>
MDEstimator(x, ParamFamily, distance = KolmogorovDist, dist.name,
- startPar = NULL, Infos, trafo = NULL,
+ paramDepDist = FALSE, startPar = NULL, Infos, trafo = NULL,
penalty = 1e20, asvar.fct, ...)
</pre>
@@ -46,6 +46,12 @@
<tr valign="top"><td><code>dist.name</code></td>
<td>
optional name of distance </td></tr>
+<tr valign="top"><td><code>paramDepDist</code></td>
+<td>
+logical; will computation of distance be parameter
+dependent (see also note below)? if <code>TRUE</code>, distance function
+must be able to digest a parameter <code>thetaPar</code>; otherwise
+this parameter will be eliminated if present in <code>...</code>-argument.</td></tr>
<tr valign="top"><td><code>startPar</code></td>
<td>
initial information used by <code>optimize</code> resp. <code>optim</code>;
@@ -95,6 +101,17 @@
An object of S4-class <code>"MCEstimate"</code> which inherits from class
<code>"Estimate"</code>.</p>
+<h3>Note</h3>
+
+<p>
+The distance function gets called together with a parameter <code>thetaPar</code>
+which is the current parameter value under consideration, i.e.; the value
+under which the model distribution is considered. Hence, if desired,
+particular distance functions could make use of this information, by, say
+computing the distance differently for different parameter values.
+</p>
+
+
<h3>Author(s)</h3>
<p>
Modified: branches/distr-2.2/pkg/distrMod/chm/distrMod.chm
===================================================================
(Binary files differ)
Modified: branches/distr-2.2/pkg/distrMod/chm/distrMod.toc
===================================================================
--- branches/distr-2.2/pkg/distrMod/chm/distrMod.toc 2009-07-31 21:58:15 UTC (rev 519)
+++ branches/distr-2.2/pkg/distrMod/chm/distrMod.toc 2009-08-04 05:14:21 UTC (rev 520)
@@ -922,6 +922,14 @@
<param name="Local" value="onesidedBias-class.html">
</OBJECT>
<LI> <OBJECT type="text/sitemap">
+<param name="Name" value="optimwarn">
+<param name="Local" value="MCEstimate-class.html">
+</OBJECT>
+<LI> <OBJECT type="text/sitemap">
+<param name="Name" value="optimwarn,MCEstimate-method">
+<param name="Local" value="MCEstimate-class.html">
+</OBJECT>
+<LI> <OBJECT type="text/sitemap">
<param name="Name" value="p,ProbFamily-method">
<param name="Local" value="ProbFamily-class.html">
</OBJECT>
Modified: branches/distr-2.2/pkg/distrMod/chm/meRes.html
===================================================================
--- branches/distr-2.2/pkg/distrMod/chm/meRes.html 2009-07-31 21:58:15 UTC (rev 519)
+++ branches/distr-2.2/pkg/distrMod/chm/meRes.html 2009-08-04 05:14:21 UTC (rev 520)
@@ -27,7 +27,7 @@
<pre>
meRes(x, estimate, criterion.value, param, crit.fct, method = "explicit solution",
- crit.name = "Maximum Likelihood", Infos)
+ crit.name = "Maximum Likelihood", Infos, warns = "")
get.criterion.fct(theta, Data, ParamFam, criterion.ff, fun, ...)
## S4 method for signature 'numeric':
samplesize(object)
@@ -66,6 +66,9 @@
<td>
optional matrix of characters in two columns;
information to be attached to the estimate</td></tr>
+<tr valign="top"><td><code>warns</code></td>
+<td>
+collected warnings in optimization</td></tr>
<tr valign="top"><td><code>samplesize</code></td>
<td>
numeric; the sample size at which the estimator
Modified: branches/distr-2.2/pkg/distrMod/chm/mleCalc-methods.html
===================================================================
--- branches/distr-2.2/pkg/distrMod/chm/mleCalc-methods.html 2009-07-31 21:58:15 UTC (rev 519)
+++ branches/distr-2.2/pkg/distrMod/chm/mleCalc-methods.html 2009-08-04 05:14:21 UTC (rev 520)
@@ -38,7 +38,7 @@
## S4 method for signature 'numeric, ParamFamily':
mceCalc(x, PFam, criterion,
startPar = NULL, penalty = 1e20, crit.name,
- Infos = NULL, ...)
+ Infos = NULL, withthetaPar = FALSE,...)
## S4 method for signature 'numeric, ParamFamily':
mleCalc(x, PFam, startPar = NULL,
penalty = 1e20, Infos = NULL, ...)
@@ -80,6 +80,9 @@
<tr valign="top"><td><code>crit.name</code></td>
<td>
character; the name of the criterion; may be missing</td></tr>
+<tr valign="top"><td><code>withthetaPar</code></td>
+<td>
+logical; shall Parameter theta be transmitted?</td></tr>
<tr valign="top"><td><code>Infos</code></td>
<td>
matrix; info slot to be filled in object of class <code>MCEstimate</code>;
Modified: branches/distr-2.2/pkg/distrMod/man/MCEstimate-class.Rd
===================================================================
--- branches/distr-2.2/pkg/distrMod/man/MCEstimate-class.Rd 2009-07-31 21:58:15 UTC (rev 519)
+++ branches/distr-2.2/pkg/distrMod/man/MCEstimate-class.Rd 2009-08-04 05:14:21 UTC (rev 520)
@@ -6,7 +6,9 @@
\alias{criterion.fct}
\alias{criterion.fct,MCEstimate-method}
\alias{method}
+\alias{optimwarn}
\alias{method,MCEstimate-method}
+\alias{optimwarn,MCEstimate-method}
\alias{criterion<-}
\alias{criterion<-,MCEstimate-method}
\alias{coerce,MCEstimate,mle-method}
@@ -44,6 +46,8 @@
\item{\code{Infos}:}{ object of class \code{"matrix"}
with two columns named \code{method} and \code{message}:
additional informations. }
+ \item{\code{optimwarn}:}{ object of class \code{"character"}
+ warnings issued during optimization. }
\item{\code{asvar}:}{ object of class \code{"OptionalMatrix"}
which may contain the asymptotic (co)variance of the estimator. }
\item{\code{samplesize}:}{ object of class \code{"numeric"} ---
@@ -68,7 +72,10 @@
\item{criterion<-}{\code{signature(object = "MCEstimate")}:
replacement function for slot \code{criterion}. }
- \item{criterion.fct}{\code{signature(object = "MCEstimate")}:
+ \item{optimwarn}{\code{signature(object = "MCEstimate")}:
+ accessor function for slot \code{optimwarn}. }
+
+ \item{criterion.fct}{\code{signature(object = "MCEstimate")}:
accessor function for slot \code{criterion.fct}. }
\item{show}{\code{signature(object = "Estimate")}}
Modified: branches/distr-2.2/pkg/distrMod/man/MCEstimator.Rd
===================================================================
--- branches/distr-2.2/pkg/distrMod/man/MCEstimator.Rd 2009-07-31 21:58:15 UTC (rev 519)
+++ branches/distr-2.2/pkg/distrMod/man/MCEstimator.Rd 2009-08-04 05:14:21 UTC (rev 520)
@@ -51,6 +51,11 @@
An object of S4-class \code{"MCEstimate"} which inherits from class
\code{"Estimate"}.
}
+\note{The criterion function may be called together with a parameter \code{thetaPar}
+ which is the current parameter value under consideration, i.e.; the value
+ under which the model distribution is considered. Hence, if desired,
+ particular criterion functions could make use of this information, by, say
+ computing the criterion differently for different parameter values.}
%\references{ }
\author{Matthias Kohl \email{Matthias.Kohl at stamats.de},\cr
Peter Ruckdeschel \email{Peter.Ruckdeschel at itwm.fraunhofer.de}}
Modified: branches/distr-2.2/pkg/distrMod/man/MDEstimator.Rd
===================================================================
--- branches/distr-2.2/pkg/distrMod/man/MDEstimator.Rd 2009-07-31 21:58:15 UTC (rev 519)
+++ branches/distr-2.2/pkg/distrMod/man/MDEstimator.Rd 2009-08-04 05:14:21 UTC (rev 520)
@@ -8,7 +8,7 @@
}
\usage{
MDEstimator(x, ParamFamily, distance = KolmogorovDist, dist.name,
- startPar = NULL, Infos, trafo = NULL,
+ paramDepDist = FALSE, startPar = NULL, Infos, trafo = NULL,
penalty = 1e20, asvar.fct, ...)
}
%- maybe also 'usage' for other objects documented here.
@@ -18,6 +18,10 @@
\item{distance}{ (generic) function: to compute distance beetween (emprical)
data and objects of class \code{"Distribution"}. }
\item{dist.name}{ optional name of distance }
+ \item{paramDepDist}{logical; will computation of distance be parameter
+ dependent (see also note below)? if \code{TRUE}, distance function
+ must be able to digest a parameter \code{thetaPar}; otherwise
+ this parameter will be eliminated if present in \code{...}-argument.}
\item{startPar}{ initial information used by \code{optimize} resp. \code{optim};
i.e; if (total) parameter is of length 1, \code{startPar} is
a search interval, else it is an initial parameter value; if \code{NULL}
@@ -48,6 +52,11 @@
An object of S4-class \code{"MCEstimate"} which inherits from class
\code{"Estimate"}.
}
+\note{The distance function may be called together with a parameter \code{thetaPar}
+ which is the current parameter value under consideration, i.e.; the value
+ under which the model distribution is considered. Hence, if desired,
+ particular distance functions could make use of this information, by, say
+ computing the distance differently for different parameter values.}
\references{
Huber, P.J. (1981) \emph{Robust Statistics}. New York: Wiley.
Modified: branches/distr-2.2/pkg/distrMod/man/meRes.Rd
===================================================================
--- branches/distr-2.2/pkg/distrMod/man/meRes.Rd 2009-07-31 21:58:15 UTC (rev 519)
+++ branches/distr-2.2/pkg/distrMod/man/meRes.Rd 2009-08-04 05:14:21 UTC (rev 520)
@@ -9,7 +9,7 @@
\usage{
meRes(x, estimate, criterion.value, param, crit.fct, method = "explicit solution",
- crit.name = "Maximum Likelihood", Infos)
+ crit.name = "Maximum Likelihood", Infos, warns = "")
get.criterion.fct(theta, Data, ParamFam, criterion.ff, fun, ...)
\S4method{samplesize}{numeric}(object)
}
@@ -27,6 +27,7 @@
\item{crit.name}{character; name of the criterion}
\item{Infos}{optional matrix of characters in two columns;
information to be attached to the estimate}
+ \item{warns}{collected warnings in optimization}
\item{samplesize}{numeric; the sample size at which the estimator
was evaluated}
\item{theta}{the parameter value as named numeric vector}
Modified: branches/distr-2.2/pkg/distrMod/man/mleCalc-methods.Rd
===================================================================
--- branches/distr-2.2/pkg/distrMod/man/mleCalc-methods.Rd 2009-07-31 21:58:15 UTC (rev 519)
+++ branches/distr-2.2/pkg/distrMod/man/mleCalc-methods.Rd 2009-08-04 05:14:21 UTC (rev 520)
@@ -20,7 +20,7 @@
mleCalc(x, PFam, ...)
\S4method{mceCalc}{numeric,ParamFamily}(x, PFam, criterion,
startPar = NULL, penalty = 1e20, crit.name,
- Infos = NULL, \dots)
+ Infos = NULL, withthetaPar = FALSE,\dots)
\S4method{mleCalc}{numeric,ParamFamily}(x, PFam, startPar = NULL,
penalty = 1e20, Infos = NULL, \dots)
\S4method{mleCalc}{numeric,BinomFamily}(x, PFam, \dots)
@@ -39,6 +39,7 @@
(one-dim) parameter}
\item{penalty}{numeric; penalizes non-permitted parameter values}
\item{crit.name}{character; the name of the criterion; may be missing}
+ \item{withthetaPar}{logical; shall Parameter theta be transmitted?}
\item{Infos}{matrix; info slot to be filled in object of class \code{MCEstimate};
may be missing}
\item{\dots}{additional argument(s) for \code{optim} / \code{optimize}}
More information about the Distr-commits
mailing list