[Distr-commits] r513 - in branches/distr-2.2/pkg: distrMod/R distrMod/chm distrMod/man distrSim/man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Thu Jul 23 17:45:47 CEST 2009
Author: ruckdeschel
Date: 2009-07-23 17:45:46 +0200 (Thu, 23 Jul 2009)
New Revision: 513
Modified:
branches/distr-2.2/pkg/distrMod/R/mleCalc-methods.R
branches/distr-2.2/pkg/distrMod/chm/distrMod.chm
branches/distr-2.2/pkg/distrMod/chm/meRes.html
branches/distr-2.2/pkg/distrMod/man/meRes.Rd
branches/distr-2.2/pkg/distrSim/man/summary-methods.Rd
Log:
small changes in mceCalc --- penalty now allows for functions and naming is "more" unique (to avoid unintended name clashes)
Modified: branches/distr-2.2/pkg/distrMod/R/mleCalc-methods.R
===================================================================
--- branches/distr-2.2/pkg/distrMod/R/mleCalc-methods.R 2009-07-17 17:24:03 UTC (rev 512)
+++ branches/distr-2.2/pkg/distrMod/R/mleCalc-methods.R 2009-07-23 15:45:46 UTC (rev 513)
@@ -14,12 +14,12 @@
meRes <- function(x, estimate, criterion.value, param, crit.fct,
method = "explicit solution",
crit.name = "Maximum Likelihood", Infos)
- return(list(estimate = estimate, criterion = criterion.value,
+ return(list(estimate = estimate, criterion = criterion.value,
param = param, crit.fct = crit.fct, method = method,
crit.name = crit.name, Infos = Infos,
samplesize = samplesize(x)))
-get.criterion.fct <- function(theta, Data, ParamFam, criterion, fun, ...){
+get.criterion.fct <- function(theta, Data, ParamFam, criterion.ff, fun, ...){
### function to produce a function criterion.fct for profiling /
## filling slot 'minuslogl' in object coerced to class mle:
@@ -48,7 +48,7 @@
th0 <- c(unlist(th0))
do.call(fun, c(list(theta = th0, Data = Data,
ParamFamily = ParamFam,
- criterion = criterion) ,
+ criterion = criterion.ff) ,
dots))
}
crit.lst[l+1] <- as.list(ft)[1]
@@ -87,27 +87,36 @@
fixed <- fixed(PFam)
- fun <- function(theta, Data, ParamFamily, criterion, ...){
+ fun <- function(theta, Data, ParamFamily, criterionF, ...){
vP <- validParameter(ParamFamily, theta)
- if(!vP) crit <- penalty
+ dots <- list(...)
+ dots$trafo <- NULL
+ dots$penalty <- NULL
+ dots$withBiasC <- NULL
+ if(is.function(penalty)) penalty <- penalty(theta)
+ if(!vP) crit0 <- penalty
else{
if(lnx)
names(theta) <- c(names(main(ParamFamily)),
names(nuisance(ParamFamily)))
else names(theta) <- names(main(ParamFamily))
- distr.new <- try(ParamFamily at modifyParam(theta),silent = TRUE)
- if(is(distr.new,"try.error")) crit <- penalty
- else{ crit <- try(criterion(Data, distr.new, ...),
- silent = TRUE)
- if(is(crit, "try-error")) crit <- penalty
+ distr.new <- try(ParamFamily at modifyParam(theta), silent = TRUE)
+ argList <- c(list(x = Data, Distribution = distr.new), dots)
+ if(is(distr.new,"try.error"))
+ crit0 <- penalty
+ else{
+ crit0 <- try(do.call(what = criterionF, args = argList),
+ silent = TRUE)
+ if(is(crit0, "try-error"))
+ crit0 <- penalty
}
}
- critP <- crit + penalty * (1-vP)
+ critP <- crit0 + penalty * (1-vP)
return(critP)}
if(length(param(PFam)) == 1){
res <- optimize(f = fun, interval = startPar, Data = x,
- ParamFamily = PFam, criterion = criterion, ...)
+ ParamFamily = PFam, criterionF = criterion, ...)
theta <- res$minimum
names(theta) <- names(main(PFam))
crit <- res$objectiv
@@ -115,7 +124,7 @@
}else{
if(is(startPar,"Estimate")) startPar <- untransformed.estimate(startPar)
res <- optim(par = startPar, fn = fun, Data = x, ParamFamily = PFam,
- criterion = criterion, ...)
+ criterionF = criterion, ...)
theta <- as.numeric(res$par)
names(theta) <- c(names(main(PFam)),names(nuisance(PFam)))
method <- "optim"
@@ -141,11 +150,11 @@
names(nuisance(ParamFamily)))
else names(theta) <- names(main(ParamFamily))
distr.new <- ParamFamily at modifyParam(theta)
- crit <- criterion(Data, distr.new, ...)
- return(crit)}
+ crit1 <- criterion(Data, distr.new, ...)
+ return(crit1)}
crit.fct <- get.criterion.fct(theta, Data = x, ParamFam = PFam,
- criterion, fun2, ...)
+ criterion.ff = criterion, fun2, ...)
return(meRes(x, theta, crit, param, crit.fct, method = method,
crit.name = crit.name, Infos = Infos))
Modified: branches/distr-2.2/pkg/distrMod/chm/distrMod.chm
===================================================================
(Binary files differ)
Modified: branches/distr-2.2/pkg/distrMod/chm/meRes.html
===================================================================
--- branches/distr-2.2/pkg/distrMod/chm/meRes.html 2009-07-17 17:24:03 UTC (rev 512)
+++ branches/distr-2.2/pkg/distrMod/chm/meRes.html 2009-07-23 15:45:46 UTC (rev 513)
@@ -28,7 +28,7 @@
<pre>
meRes(x, estimate, criterion.value, param, crit.fct, method = "explicit solution",
crit.name = "Maximum Likelihood", Infos)
-get.criterion.fct(theta, Data, ParamFam, criterion, fun, ...)
+get.criterion.fct(theta, Data, ParamFam, criterion.ff, fun, ...)
## S4 method for signature 'numeric':
samplesize(object)
</pre>
@@ -80,7 +80,7 @@
<td>
an object of class <code>ParamFamily</code>;
the parametric family at which to evaluate the MCE</td></tr>
-<tr valign="top"><td><code>criterion</code></td>
+<tr valign="top"><td><code>criterion.ff</code></td>
<td>
the criterion function used in the MCE</td></tr>
<tr valign="top"><td><code>fun</code></td>
Modified: branches/distr-2.2/pkg/distrMod/man/meRes.Rd
===================================================================
--- branches/distr-2.2/pkg/distrMod/man/meRes.Rd 2009-07-17 17:24:03 UTC (rev 512)
+++ branches/distr-2.2/pkg/distrMod/man/meRes.Rd 2009-07-23 15:45:46 UTC (rev 513)
@@ -10,7 +10,7 @@
\usage{
meRes(x, estimate, criterion.value, param, crit.fct, method = "explicit solution",
crit.name = "Maximum Likelihood", Infos)
-get.criterion.fct(theta, Data, ParamFam, criterion, fun, ...)
+get.criterion.fct(theta, Data, ParamFam, criterion.ff, fun, ...)
\S4method{samplesize}{numeric}(object)
}
\arguments{
@@ -33,7 +33,7 @@
\item{Data}{numeric; the data at which to evaluate the MCE}
\item{ParamFam}{an object of class \code{ParamFamily};
the parametric family at which to evaluate the MCE}
- \item{criterion}{the criterion function used in the MCE}
+ \item{criterion.ff}{the criterion function used in the MCE}
\item{fun}{wrapper to the criterion function used in the MCE
(with certain checking whether parameter value is permitted and possibly
penalizing if not; see code to , for example.)}
Modified: branches/distr-2.2/pkg/distrSim/man/summary-methods.Rd
===================================================================
--- branches/distr-2.2/pkg/distrSim/man/summary-methods.Rd 2009-07-17 17:24:03 UTC (rev 512)
+++ branches/distr-2.2/pkg/distrSim/man/summary-methods.Rd 2009-07-23 15:45:46 UTC (rev 513)
@@ -4,7 +4,7 @@
\alias{summary,Dataclass-method}
\alias{summary,Simulation-method}
\alias{summary,Contsimulation-method}
-\title{ Methods for Function summary in Package `distrSim' }
+\title{ Methods for Function summary in Package 'distrSim' }
\description{summary-methods}
\section{Methods}{
@@ -20,11 +20,14 @@
is a global option, see \code{\link[distrSim]{distrSimoptions}}}
}}
-\item{summary}{\code{signature(object = "Simulation")}: returns name, filename, seed, number of runs, the size of the sample and a
+\item{summary}{\code{signature(object = "Simulation")}: returns name, filename,
+seed, number of runs, the size of the sample and a
statistical summary for each run; optional arguments: as with \code{signature(object = "Dataclass")} }
-\item{summary}{\code{signature(object = "Contsimulation")}: returns name, filename, seed, number of runs, the size of the sample, the
- rate and a statistical summary for each run of the real data; optional arguments: as with \code{signature(object = "Dataclass")} }
+\item{summary}{\code{signature(object = "Contsimulation")}: returns name, filename,
+seed, number of runs, the size of the sample, the
+ rate and a statistical summary for each run of the real data; optional arguments:
+ as with \code{signature(object = "Dataclass")} }
}}
\concept{summary}
\keyword{methods}
More information about the Distr-commits
mailing list