[Distr-commits] r198 - in branches/distr-2.0/pkg/distrMod: . R man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Mon Jul 28 07:49:17 CEST 2008
Author: stamats
Date: 2008-07-28 07:49:17 +0200 (Mon, 28 Jul 2008)
New Revision: 198
Modified:
branches/distr-2.0/pkg/distrMod/DESCRIPTION
branches/distr-2.0/pkg/distrMod/NAMESPACE
branches/distr-2.0/pkg/distrMod/R/AllClass.R
branches/distr-2.0/pkg/distrMod/R/AllGeneric.R
branches/distr-2.0/pkg/distrMod/R/AllShow.R
branches/distr-2.0/pkg/distrMod/R/MCEstimator.R
branches/distr-2.0/pkg/distrMod/R/MDEstimator.R
branches/distr-2.0/pkg/distrMod/R/MLEstimator.R
branches/distr-2.0/pkg/distrMod/man/MCEstimator.Rd
branches/distr-2.0/pkg/distrMod/man/MDEstimator.Rd
branches/distr-2.0/pkg/distrMod/man/MLEstimator.Rd
Log:
Switched from S3-class Estimate to formal S4-class Estimate with corresponding subclasses and accessor/replacment methods.
Modified: branches/distr-2.0/pkg/distrMod/DESCRIPTION
===================================================================
--- branches/distr-2.0/pkg/distrMod/DESCRIPTION 2008-07-24 17:04:17 UTC (rev 197)
+++ branches/distr-2.0/pkg/distrMod/DESCRIPTION 2008-07-28 05:49:17 UTC (rev 198)
@@ -1,6 +1,6 @@
Package: distrMod
Version: 2.0
-Date: 2008-07-21
+Date: 2008-07-28
Title: Object orientated implementation of probability models
Description: Object orientated implementation of probability models based on packages 'distr' and 'distrEx'
Author: Florian Camphausen, Matthias Kohl, Peter Ruckdeschel, Thomas Stabla
Modified: branches/distr-2.0/pkg/distrMod/NAMESPACE
===================================================================
--- branches/distr-2.0/pkg/distrMod/NAMESPACE 2008-07-24 17:04:17 UTC (rev 197)
+++ branches/distr-2.0/pkg/distrMod/NAMESPACE 2008-07-28 05:49:17 UTC (rev 198)
@@ -23,6 +23,7 @@
exportClasses("L2GroupParamFamily", "L2LocationFamily",
"L2ScaleFamily", "L2LocationScaleFamily")
exportClasses("NormType", "QFNorm", "InfoNorm", "SelfNorm")
+exportClasses("Estimate", "MCEstimate")
exportMethods("type", "SymmCenter", "distrSymm",
"distribution", "props", "props<-", "addProp<-", "main", "main<-",
"nuisance", "nuisance<-", "trafo", "trafo<-", "modifyParam",
@@ -36,10 +37,13 @@
exportMethods("modifyModel")
exportMethods("norm", "QuadForm<-", "QuadForm", "fct",
"fct<-", "normtype", "normtype<-")
-S3method(print, Estimate)
+exportMethods("name", "name<-",
+ "estimate",
+ "Infos", "Infos<-", "addInfo<-",
+ "criterion", "criterion<-")
export("PosDefSymmMatrix","PosSemDefSymmMatrix")
export("distrModOptions", "getdistrModOption",
- "MCEstimator", "MLEstimator", "MDEstimator")
+ "Estimator", "MCEstimator", "MLEstimator", "MDEstimator")
export("NoSymmetry", "EllipticalSymmetry", "SphericalSymmetry",
"NonSymmetric", "EvenSymmetric", "OddSymmetric",
"DistrSymmList", "FunSymmList")
Modified: branches/distr-2.0/pkg/distrMod/R/AllClass.R
===================================================================
--- branches/distr-2.0/pkg/distrMod/R/AllClass.R 2008-07-24 17:04:17 UTC (rev 197)
+++ branches/distr-2.0/pkg/distrMod/R/AllClass.R 2008-07-28 05:49:17 UTC (rev 198)
@@ -403,3 +403,35 @@
contains = "asGRisk",
prototype = prototype(type = "asymptotic Semivariance",
biastype = new("onesidedBias")))
+
+#################################################
+## "Estimate" classes
+#################################################
+setClass("Estimate",
+ representation(name = "character",
+ estimate = "ANY",
+ Infos = "matrix"),
+ prototype(name = "Estimate",
+ estimate = numeric(0),
+ Infos = matrix(c(character(0),character(0)), ncol=2,
+ dimnames=list(character(0), c("method", "message")))),
+ validity = function(object){
+ if(!is.character(object at Infos))
+ stop("'Infos' contains no matrix of characters")
+ if(ncol(object at Infos)!=2)
+ stop("'Infos' must have two columns")
+ else TRUE
+ })
+
+setClass("MCEstimate",
+ representation(criterion = "numeric"),
+ prototype(name = "Minimum criterion estimate",
+ estimate = numeric(0),
+ criterion = numeric(0),
+ Infos = matrix(c(character(0),character(0)), ncol=2,
+ dimnames=list(character(0), c("method", "message")))),
+ contains = "Estimate")
+
+## To Do: class MLEstimate which is compatible with class
+## mle or maybe class summary.mle of package "stats4"
+
Modified: branches/distr-2.0/pkg/distrMod/R/AllGeneric.R
===================================================================
--- branches/distr-2.0/pkg/distrMod/R/AllGeneric.R 2008-07-24 17:04:17 UTC (rev 197)
+++ branches/distr-2.0/pkg/distrMod/R/AllGeneric.R 2008-07-28 05:49:17 UTC (rev 198)
@@ -138,3 +138,21 @@
if(!isGeneric("fct")){
setGeneric("fct", function(object) standardGeneric("fct"))
}
+if(!isGeneric("estimate")){
+ setGeneric("estimate", function(object) standardGeneric("estimate"))
+}
+if(!isGeneric("Infos")){
+ setGeneric("Infos", function(object) standardGeneric("Infos"))
+}
+if(!isGeneric("Infos<-")){
+ setGeneric("Infos<-", function(object, value) standardGeneric("Infos<-"))
+}
+if(!isGeneric("addInfo<-")){
+ setGeneric("addInfo<-", function(object, value) standardGeneric("addInfo<-"))
+}
+if(!isGeneric("criterion")){
+ setGeneric("criterion", function(object) standardGeneric("criterion"))
+}
+if(!isGeneric("criterion<-")){
+ setGeneric("criterion<-", function(object, value) standardGeneric("criterion<-"))
+}
Modified: branches/distr-2.0/pkg/distrMod/R/AllShow.R
===================================================================
--- branches/distr-2.0/pkg/distrMod/R/AllShow.R 2008-07-24 17:04:17 UTC (rev 197)
+++ branches/distr-2.0/pkg/distrMod/R/AllShow.R 2008-07-28 05:49:17 UTC (rev 198)
@@ -90,3 +90,12 @@
cat("risk type:\t", object at type, "\n")
cat("bound:\t", object at bound, "\n")
})
+
+setMethod("show", "Estimate",
+ function(object){
+ cat(paste("An object of class", dQuote(class(object)), "\n"))
+ cat("estimate:\n")
+ print(object at estimate)
+ if(nrow(object at Infos) > 0)
+ cat("Infos:\t", object at Infos, "\n")
+ })
Modified: branches/distr-2.0/pkg/distrMod/R/MCEstimator.R
===================================================================
--- branches/distr-2.0/pkg/distrMod/R/MCEstimator.R 2008-07-24 17:04:17 UTC (rev 197)
+++ branches/distr-2.0/pkg/distrMod/R/MCEstimator.R 2008-07-28 05:49:17 UTC (rev 198)
@@ -1,5 +1,8 @@
+###############################################################################
## Determine estimator by minimizing a given criterion
-MCEstimator <- function(x, ParamFamily, criterion, crit.name, interval, par, ...){
+###############################################################################
+MCEstimator <- function(x, ParamFamily, criterion, crit.name, interval, par,
+ Infos, ...){
if(!is.numeric(x))
stop(gettext("'x' has to be a numeric vector"))
if(!is(ParamFamily, "ParamFamily"))
@@ -31,10 +34,18 @@
names(crit) <- crit.name
}
- structure(list("estimate" = theta, "criterion" = crit), class = c("MCEstimate", "Estimate"))
-}
+ if(missing(crit.name))
+ est.name <- "Minimum criterion estimate"
+ else
+ est.name <- paste("Minimum", crit.name, "estimate", sep = " ")
+ if(missing(Infos))
+ Infos <- matrix(c(character(0),character(0)), ncol=2,
+ dimnames=list(character(0), c("method", "message")))
+ else{
+ Infos <- matrix(c(rep("MCEstimator", length(Infos)), Infos), ncol = 2)
+ colnames(Infos) <- c("method", "message")
+ }
-## print method for objects of class Estimate
-print.Estimate <- function(x, digits = getOption("digits"), ...){
- print(x$estimate)
+ new("MCEstimate", name = est.name, estimate = theta, criterion = crit,
+ Infos = Infos)
}
Modified: branches/distr-2.0/pkg/distrMod/R/MDEstimator.R
===================================================================
--- branches/distr-2.0/pkg/distrMod/R/MDEstimator.R 2008-07-24 17:04:17 UTC (rev 197)
+++ branches/distr-2.0/pkg/distrMod/R/MDEstimator.R 2008-07-28 05:49:17 UTC (rev 198)
@@ -1,13 +1,15 @@
+###############################################################################
## Implementation of minimum distance estimation
-MDEstimator <- function(x, ParamFamily, distance = KolmogorovDist, dist.name, interval, par, ...){
+###############################################################################
+MDEstimator <- function(x, ParamFamily, distance = KolmogorovDist, dist.name,
+ interval, par, Infos, ...){
res <- MCEstimator(x = x, ParamFamily = ParamFamily, criterion = distance,
- interval = interval, par = par, ...)
+ interval = interval, par = par, Infos = Infos, ...)
if(missing(dist.name))
dist.name <- names(distance(x, ParamFamily at distribution))
-# names(res)[2] <- "distance"
-# if(!is.null(dist.name)) names(res$distance) <- dist.name
- if(!is.null(dist.name)) names(res$criterion) <- dist.name
- class(res) <- c("MCEstimate", "Estimate")
+ names(res at criterion) <- dist.name
+ res at name <- paste("Minimum", dist.name, "estimate", sep = " ")
+
return(res)
}
Modified: branches/distr-2.0/pkg/distrMod/R/MLEstimator.R
===================================================================
--- branches/distr-2.0/pkg/distrMod/R/MLEstimator.R 2008-07-24 17:04:17 UTC (rev 197)
+++ branches/distr-2.0/pkg/distrMod/R/MLEstimator.R 2008-07-28 05:49:17 UTC (rev 198)
@@ -1,4 +1,6 @@
+###############################################################################
## Implementation of Maximum Likelihood estimation in i.i.d. setup
+###############################################################################
# compute likelihood
#likelihood <- function(x, Distribution, ...){
@@ -22,7 +24,7 @@
#}
## Maximum-Likelihood estimator
-MLEstimator <- function(x, ParamFamily, interval, par, ...){
+MLEstimator <- function(x, ParamFamily, interval, par, Infos, ...){
negLoglikelihood <- function(x, Distribution, ...){
res <- -sum(log(Distribution at d(x, ...)))
return(res)
@@ -30,8 +32,8 @@
res <- MCEstimator(x = x, ParamFamily = ParamFamily, criterion = negLoglikelihood,
interval = interval, par = par, ...)
- names(res$criterion) <- "negative log-likelihood"
- class(res) <- c("MCEstimator", "Estimate")
+ names(res at criterion) <- "negative log-likelihood"
+ res at name <- "Maximum likelihood estimate"
return(res)
}
Modified: branches/distr-2.0/pkg/distrMod/man/MCEstimator.Rd
===================================================================
--- branches/distr-2.0/pkg/distrMod/man/MCEstimator.Rd 2008-07-24 17:04:17 UTC (rev 197)
+++ branches/distr-2.0/pkg/distrMod/man/MCEstimator.Rd 2008-07-28 05:49:17 UTC (rev 198)
@@ -11,7 +11,8 @@
case of minimum distance estimators.
}
\usage{
-MCEstimator(x, ParamFamily, criterion, crit.name, interval, par, ...)
+MCEstimator(x, ParamFamily, criterion, crit.name, interval, par,
+ Infos, ...)
}
\arguments{
\item{x}{ (empirical) data }
@@ -21,6 +22,7 @@
\item{interval}{ interval used by \code{optimize} }
\item{par}{ initial parameter values used by \code{optim}; if \code{missing}
the parameter of \code{ParamFamily} are used. }
+ \item{Infos}{ character: optional informations about estimator }
\item{\dots}{ further arguments to \code{criterion} or \code{optimize}
or \code{optim}, respectively. }
}
@@ -30,16 +32,15 @@
and possibly \code{\dots}.
}
\value{
- An object of S3-class \code{"MCEstimate"} which inherits from class \code{"Estimate"},
- a list with two components
- \item{estimate}{ minimum criterion parameter estimate }
- \item{criterion}{ minimum value of the criterion }
+ An object of S4-class \code{"MCEstimate"} which inherits from class
+ \code{"Estimate"}.
}
%\references{ }
\author{Matthias Kohl \email{Matthias.Kohl at stamats.de},\cr
Peter Ruckdeschel \email{Peter.Ruckdeschel at itwm.fraunhofer.de}}
%\note{}
-\seealso{\code{\link{ParamFamily-class}}, \code{\link{ParamFamily}} }
+\seealso{\code{\link{ParamFamily-class}}, \code{\link{ParamFamily}},
+ \code{\link{MCEstimate-class}} }
\examples{
## (empirical) Data
x <- rgamma(50, scale = 0.5, shape = 3)
Modified: branches/distr-2.0/pkg/distrMod/man/MDEstimator.Rd
===================================================================
--- branches/distr-2.0/pkg/distrMod/man/MDEstimator.Rd 2008-07-24 17:04:17 UTC (rev 197)
+++ branches/distr-2.0/pkg/distrMod/man/MDEstimator.Rd 2008-07-28 05:49:17 UTC (rev 198)
@@ -7,7 +7,8 @@
minimum distance estimators.
}
\usage{
-MDEstimator(x, ParamFamily, distance = KolmogorovDist, dist.name, interval, par, ...)
+MDEstimator(x, ParamFamily, distance = KolmogorovDist, dist.name, interval, par,
+ Infos, ...)
}
%- maybe also 'usage' for other objects documented here.
\arguments{
@@ -19,6 +20,7 @@
\item{interval}{ interval used by \code{optimize} }
\item{par}{ initial parameter values used by \code{optim}; if \code{missing}
the parameter of \code{ParamFamily} are used. }
+ \item{Infos}{ character: optional informations about estimator }
\item{\dots}{ further arguments to \code{criterion} or \code{optimize}
or \code{optim}, respectively. }
}
@@ -29,10 +31,8 @@
\code{TotalVarDist} or \code{HellingerDist}.
}
\value{
- An object of S3-class \code{"MCEstimate"} which inherits from
- class \code{"Estimate"}, a list with two components
- \item{estimate}{ maximum likelihood parameter estimate }
- \item{criterion}{ minimum value of the distance }
+ An object of S4-class \code{"MCEstimate"} which inherits from class
+ \code{"Estimate"}.
}
\references{
Huber, P.J. (1981) \emph{Robust Statistics}. New York: Wiley.
@@ -42,7 +42,8 @@
\author{Matthias Kohl \email{Matthias.Kohl at stamats.de},\cr
Peter Ruckdeschel \email{Peter.Ruckdeschel at itwm.fraunhofer.de}}
%\note{}
-\seealso{\code{\link{ParamFamily-class}}, \code{\link{ParamFamily}}, code{\link{MCEstimator}},
+\seealso{\code{\link{ParamFamily-class}}, \code{\link{ParamFamily}},
+ \code{\link{MCEstimator}, \code{\link{MCEstimate-class}}},
\code{\link[MASS]{fitdistr}} }
\examples{
## (empirical) Data
Modified: branches/distr-2.0/pkg/distrMod/man/MLEstimator.Rd
===================================================================
--- branches/distr-2.0/pkg/distrMod/man/MLEstimator.Rd 2008-07-24 17:04:17 UTC (rev 197)
+++ branches/distr-2.0/pkg/distrMod/man/MLEstimator.Rd 2008-07-28 05:49:17 UTC (rev 198)
@@ -9,7 +9,7 @@
\code{MCEstimator} which minimizes the negative log-Likelihood.
}
\usage{
-MLEstimator(x, ParamFamily, interval, par, ...)
+MLEstimator(x, ParamFamily, interval, par, Infos, ...)
}
%- maybe also 'usage' for other objects documented here.
\arguments{
@@ -18,6 +18,7 @@
\item{interval}{ interval used by \code{optimize} }
\item{par}{ initial parameter values used by \code{optim}; if \code{missing}
the parameter of \code{ParamFamily} are used. }
+ \item{Infos}{ character: optional informations about estimator }
\item{\dots}{ further arguments to \code{criterion} or \code{optimize}
or \code{optim}, respectively. }
}
@@ -26,16 +27,15 @@
as criterion which should be minimized.
}
\value{
- An object of S3-class \code{"MCEstimate"} which inherits from
- class \code{"Estimate"}, a list with two components
- \item{estimate}{ maximum likelihood parameter estimate }
- \item{criterion}{ minimum value of the negative log-likelihood }
+ An object of S4-class \code{"MCEstimate"} which inherits from class
+ \code{"Estimate"}.
}
%\references{ }
\author{Matthias Kohl \email{Matthias.Kohl at stamats.de},\cr
Peter Ruckdeschel \email{Peter.Ruckdeschel at itwm.fraunhofer.de}}
%\note{}
-\seealso{\code{\link{ParamFamily-class}}, \code{\link{ParamFamily}}, code{\link{MCEstimator}},
+\seealso{\code{\link{ParamFamily-class}}, \code{\link{ParamFamily}},
+ \code{\link{MCEstimator}, \code{\link{MCEstimate-class}}},
\code{\link[MASS]{fitdistr}} }
\examples{
## (empirical) Data
@@ -53,12 +53,12 @@
## comparison
## shape
-res$estimate[2]
+estimate(res)[2]
## rate
-1/res$estimate[1]
+1/estimate(res)[1]
## log-likelihood
res1$loglik
## negative log-likelihood
-res$criterion
+criterion(res)
}
\keyword{univar}
More information about the Distr-commits
mailing list