[Robast-commits] r526 - in branches/robast-0.9/pkg/ROptEstOld: . R man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Wed Jan 9 03:00:16 CET 2013
Author: ruckdeschel
Date: 2013-01-09 03:00:15 +0100 (Wed, 09 Jan 2013)
New Revision: 526
Added:
branches/robast-0.9/pkg/ROptEstOld/R/AllInitialize.R
branches/robast-0.9/pkg/ROptEstOld/R/Functionals.R
branches/robast-0.9/pkg/ROptEstOld/R/Gumbel.R
branches/robast-0.9/pkg/ROptEstOld/R/GumbelLocationFamily.R
branches/robast-0.9/pkg/ROptEstOld/R/Kurtosis.R
branches/robast-0.9/pkg/ROptEstOld/R/Skewness.R
branches/robast-0.9/pkg/ROptEstOld/man/Gumbel-class.Rd
branches/robast-0.9/pkg/ROptEstOld/man/Gumbel.Rd
branches/robast-0.9/pkg/ROptEstOld/man/GumbelParameter-class.Rd
branches/robast-0.9/pkg/ROptEstOld/man/ROptEstOldConstants.Rd
Modified:
branches/robast-0.9/pkg/ROptEstOld/DESCRIPTION
branches/robast-0.9/pkg/ROptEstOld/NAMESPACE
branches/robast-0.9/pkg/ROptEstOld/R/AllClass.R
branches/robast-0.9/pkg/ROptEstOld/R/AllGeneric.R
branches/robast-0.9/pkg/ROptEstOld/R/Expectation.R
branches/robast-0.9/pkg/ROptEstOld/man/GumbelLocationFamily.Rd
Log:
adapted ROptEstOld to the move of Gumbel... from distrEx to RobExtremes
Modified: branches/robast-0.9/pkg/ROptEstOld/DESCRIPTION
===================================================================
--- branches/robast-0.9/pkg/ROptEstOld/DESCRIPTION 2012-11-05 07:50:51 UTC (rev 525)
+++ branches/robast-0.9/pkg/ROptEstOld/DESCRIPTION 2013-01-09 02:00:15 UTC (rev 526)
@@ -4,7 +4,7 @@
Title: Optimally robust estimation - old version
Description: Optimally robust estimation using S4 classes and methods. Old version still needed
for current versions of ROptRegTS and RobRex.
-Depends: R(>= 2.4.0), methods, distr(>= 2.2), distrEx(>= 2.2), RandVar(>= 0.7)
+Depends: R(>= 2.4.0), methods, distr(>= 2.2), distrEx(>= 2.2), RandVar(>= 0.7), evd
Author: Matthias Kohl
Maintainer: Matthias Kohl <Matthias.Kohl at stamats.de>
LazyLoad: yes
Modified: branches/robast-0.9/pkg/ROptEstOld/NAMESPACE
===================================================================
--- branches/robast-0.9/pkg/ROptEstOld/NAMESPACE 2012-11-05 07:50:51 UTC (rev 525)
+++ branches/robast-0.9/pkg/ROptEstOld/NAMESPACE 2013-01-09 02:00:15 UTC (rev 526)
@@ -134,3 +134,10 @@
"IC",
"ContIC",
"TotalVarIC")
+exportClasses("GumbelParameter", "Gumbel")
+exportMethods("initialize", "loc", "loc<-")
+exportMethods("scale", "scale<-", "+", "*",
+ "E", "var", "skewness", "kurtosis")
+export("EULERMASCHERONICONSTANT","APERYCONSTANT")
+export("Gumbel")
+export("loc", "loc<-")
\ No newline at end of file
Modified: branches/robast-0.9/pkg/ROptEstOld/R/AllClass.R
===================================================================
--- branches/robast-0.9/pkg/ROptEstOld/R/AllClass.R 2012-11-05 07:50:51 UTC (rev 525)
+++ branches/robast-0.9/pkg/ROptEstOld/R/AllClass.R 2013-01-09 02:00:15 UTC (rev 526)
@@ -1,10 +1,57 @@
.onLoad <- function(lib, pkg){
- require("methods", character = TRUE, quietly = TRUE)
- require("distr", character = TRUE, quietly = TRUE)
- require("distrEx", character = TRUE, quietly = TRUE)
- require("RandVar", character = TRUE, quietly = TRUE)
}
+# parameter of Gumbel distribution
+setClass("GumbelParameter", representation(loc = "numeric",
+ scale = "numeric"),
+ prototype(name = gettext("parameter of a Gumbel distribution"),
+ loc = 0, scale = 1),
+ contains = "Parameter",
+ validity = function(object){
+ if(length(object at scale) != 1)
+ stop("length of 'scale' is not equal to 1")
+ if(length(object at loc) != 1)
+ stop("length of 'loc' is not equal to 1")
+ if(object at scale <= 0)
+ stop("'scale' has to be positive")
+ else return(TRUE)
+ })
+
+# Gumbel distribution
+setClass("Gumbel",
+ prototype = prototype(r = function(n){ rgumbel(n, loc = 0, scale = 1) },
+ d = function(x, log){ dgumbel(x, loc = 0, scale = 1, log = FALSE) },
+ p = function(q, lower.tail = TRUE, log.p = FALSE){
+ p0 <- pgumbel(q, loc = 0, scale = 1, lower.tail = lower.tail)
+ if(log.p) return(log(p0)) else return(p0)
+ },
+ q = function(p, loc = 0, scale = 1, lower.tail = TRUE, log.p = FALSE){
+ ## P.R.: changed to vectorized form
+ p1 <- if(log.p) exp(p) else p
+
+ in01 <- (p1>1 | p1<0)
+ i01 <- distr:::.isEqual01(p1)
+ i0 <- (i01 & p1<1)
+ i1 <- (i01 & p1>0)
+ ii01 <- distr:::.isEqual01(p1) | in01
+
+ p0 <- p
+ p0[ii01] <- if(log.p) log(0.5) else 0.5
+
+ q1 <- qgumbel(p0, loc = 0, scale = 1,
+ lower.tail = lower.tail)
+ q1[i0] <- if(lower.tail) -Inf else Inf
+ q1[i1] <- if(!lower.tail) -Inf else Inf
+ q1[in01] <- NaN
+
+ return(q1)
+ },
+ img = new("Reals"),
+ param = new("GumbelParameter"),
+ .logExact = FALSE,
+ .lowerExact = TRUE),
+ contains = "AbscontDistribution")
+
# symmetry of functions
setClass("FunctionSymmetry", contains = c("Symmetry", "VIRTUAL"))
Modified: branches/robast-0.9/pkg/ROptEstOld/R/AllGeneric.R
===================================================================
--- branches/robast-0.9/pkg/ROptEstOld/R/AllGeneric.R 2012-11-05 07:50:51 UTC (rev 525)
+++ branches/robast-0.9/pkg/ROptEstOld/R/AllGeneric.R 2013-01-09 02:00:15 UTC (rev 526)
@@ -230,3 +230,10 @@
if(!isGeneric("infoPlot")){
setGeneric("infoPlot", function(object) standardGeneric("infoPlot"))
}
+if(!isGeneric("loc")){
+ setGeneric("loc", function(object) standardGeneric("loc"))
+}
+
+if(!isGeneric("loc<-")){
+ setGeneric("loc<-", function(object, value) standardGeneric("loc<-"))
+}
Added: branches/robast-0.9/pkg/ROptEstOld/R/AllInitialize.R
===================================================================
--- branches/robast-0.9/pkg/ROptEstOld/R/AllInitialize.R (rev 0)
+++ branches/robast-0.9/pkg/ROptEstOld/R/AllInitialize.R 2013-01-09 02:00:15 UTC (rev 526)
@@ -0,0 +1,45 @@
+## initialize method
+setMethod("initialize", "Gumbel",
+ function(.Object, loc = 0, scale = 1) {
+ .Object at img <- Reals()
+ .Object at param <- new("GumbelParameter", loc = loc, scale = scale,
+ name = gettext("parameter of a Gumbel distribution"))
+ .Object at r <- function(n){}
+ body(.Object at r) <- substitute({ rgumbel(n, loc = loc1, scale = scale1) },
+ list(loc1 = loc, scale1 = scale))
+ .Object at d <- function(x, log = FALSE){}
+ body(.Object at d) <- substitute({ dgumbel(x, loc = loc1, scale = scale1, log = log) },
+ list(loc1 = loc, scale1 = scale))
+ .Object at p <- function(q, lower.tail = TRUE, log.p = FALSE){}
+ body(.Object at p) <- substitute({p1 <- pgumbel(q, loc = loc1, scale = scale1, lower.tail = lower.tail)
+ return(if(log.p) log(p1) else p1)},
+ list(loc1 = loc, scale1 = scale))
+ .Object at q <- function(p, loc = loc1, scale = scale1, lower.tail = TRUE, log.p = FALSE){}
+ body(.Object at q) <- substitute({
+ ## P.R.: changed to vectorized form
+ p1 <- if(log.p) exp(p) else p
+
+ in01 <- (p1>1 | p1<0)
+ i01 <- distr:::.isEqual01(p1)
+ i0 <- (i01 & p1<1)
+ i1 <- (i01 & p1>0)
+ ii01 <- distr:::.isEqual01(p1) | in01
+
+ p0 <- p
+ p0[ii01] <- if(log.p) log(0.5) else 0.5
+
+ q1 <- qgumbel(p0, loc = loc1, scale = scale1,
+ lower.tail = lower.tail)
+ q1[i0] <- if(lower.tail) -Inf else Inf
+ q1[i1] <- if(!lower.tail) -Inf else Inf
+ q1[in01] <- NaN
+
+ return(q1)
+ }, list(loc1 = loc, scale1 = scale))
+ .Object at .withSim <- FALSE
+ .Object at .withArith <- FALSE
+ .Object at .logExact <- FALSE
+ .Object at .lowerExact <- TRUE
+ .Object
+ })
+
Modified: branches/robast-0.9/pkg/ROptEstOld/R/Expectation.R
===================================================================
--- branches/robast-0.9/pkg/ROptEstOld/R/Expectation.R 2012-11-05 07:50:51 UTC (rev 525)
+++ branches/robast-0.9/pkg/ROptEstOld/R/Expectation.R 2013-01-09 02:00:15 UTC (rev 526)
@@ -22,3 +22,13 @@
return(res)
})
+setMethod("E", signature(object = "Gumbel",
+ fun = "missing",
+ cond = "missing"),
+ function(object, low = NULL, upp = NULL, ...){a <- loc(object); b <- scale(object)
+ if(is.null(low) && is.null(upp))
+ return(a- EULERMASCHERONICONSTANT * b)
+ else
+ return(E(as(object,"AbscontDistribution"), low=low, upp=upp, ...))
+ })
+## http://mathworld.wolfram.com/GumbelDistribution.html
Added: branches/robast-0.9/pkg/ROptEstOld/R/Functionals.R
===================================================================
--- branches/robast-0.9/pkg/ROptEstOld/R/Functionals.R (rev 0)
+++ branches/robast-0.9/pkg/ROptEstOld/R/Functionals.R 2013-01-09 02:00:15 UTC (rev 526)
@@ -0,0 +1,15 @@
+
+setMethod("var", signature(x = "Gumbel"),
+ function(x, ...){
+ dots <- match.call(call = sys.call(sys.parent(1)),
+ expand.dots = FALSE)$"..."
+ fun <- NULL; cond <- NULL; low <- NULL; upp <- NULL
+ if(hasArg(low)) low <- dots$low
+ if(hasArg(upp)) upp <- dots$upp
+ if(hasArg(fun)||hasArg(cond)||!is.null(low)||!is.null(upp))
+ return(var(as(x,"AbscontDistribution"),...))
+ else{ b <- scale(x)
+ return(b^2 * pi^2/6)
+ }})
+## http://mathworld.wolfram.com/GumbelDistribution.html
+
Added: branches/robast-0.9/pkg/ROptEstOld/R/Gumbel.R
===================================================================
--- branches/robast-0.9/pkg/ROptEstOld/R/Gumbel.R (rev 0)
+++ branches/robast-0.9/pkg/ROptEstOld/R/Gumbel.R 2013-01-09 02:00:15 UTC (rev 526)
@@ -0,0 +1,55 @@
+## access methods
+setMethod("loc", "GumbelParameter", function(object) object at loc)
+setMethod("scale", "GumbelParameter",
+ function(x, center = TRUE, scale = TRUE) x at scale)
+
+## replace Methods
+setReplaceMethod("loc", "GumbelParameter",
+ function(object, value){ object at loc <- value; object })
+setReplaceMethod("scale", "GumbelParameter",
+ function(object, value){ object at scale <- value; object})
+
+
+## generating function
+Gumbel <- function(loc = 0, scale = 1){ new("Gumbel", loc = loc, scale = scale) }
+
+## wrapped access methods
+setMethod("loc", "Gumbel", function(object) loc(object at param))
+setMethod("scale", "Gumbel",
+ function(x, center = TRUE, scale = TRUE) scale(x at param))
+
+## wrapped replace methods
+setMethod("loc<-", "Gumbel",
+ function(object, value){
+ new("Gumbel", loc = value, scale = scale(object))
+ })
+setMethod("scale<-", "Gumbel",
+ function(object, value){
+ if(length(value) != 1 || value <= 0)
+ stop("'value' has to be a single positive number")
+ new("Gumbel", loc = loc(object), scale = value)
+ })
+
+## extra methods for Gumbel distribution
+setMethod("+", c("Gumbel","numeric"),
+ function(e1, e2){
+ if (length(e2)>1) stop("length of operator must be 1")
+ new("Gumbel", loc = loc(e1) + e2, scale = scale(e1))
+ })
+
+setMethod("*", c("Gumbel","numeric"),
+ function(e1, e2){
+ if (length(e2)>1) stop("length of operator must be 1")
+ if (isTRUE(all.equal(e2,0)))
+ return(new("Dirac", location = 0, .withArith = TRUE))
+ new("Gumbel", loc = loc(e1) * e2, scale = scale(e1)*abs(e2))
+ })
+
+### Euler Mascheroni constant:
+EULERMASCHERONICONSTANT <- -digamma(1) ### after http://mathworld.wolfram.com/Euler-MascheroniConstant.html (48)
+
+### Apéry constant
+##local helper function:
+.fctApery <- function(n) (-1)^n*choose(2*n,n)*n^3
+##
+APERYCONSTANT <- -sum(sapply(1:50,.fctApery)^(-1))*5/2 ## after http://mathworld.wolfram.com/AperysConstant.html (8)
Added: branches/robast-0.9/pkg/ROptEstOld/R/GumbelLocationFamily.R
===================================================================
--- branches/robast-0.9/pkg/ROptEstOld/R/GumbelLocationFamily.R (rev 0)
+++ branches/robast-0.9/pkg/ROptEstOld/R/GumbelLocationFamily.R 2013-01-09 02:00:15 UTC (rev 526)
@@ -0,0 +1,31 @@
+##################################################################
+## Gumbel location family
+##################################################################
+GumbelLocationFamily <- function(loc = 0, scale = 1, trafo){
+ if(missing(trafo)) trafo <- matrix(1, dimnames = list("loc","loc"))
+ modParam <- function(theta){}
+ body(modParam) <- substitute({ Gumbel(loc = theta, scale = sd) },
+ list(sd = scale))
+ res <- L2LocationFamily(loc = loc,
+ name = "Gumbel location family",
+ locname = c("loc"="loc"),
+ centraldistribution = Gumbel(loc = 0, scale = scale),
+ modParam = modParam,
+ LogDeriv = function(x) (1 - exp(-x/scale))/scale,
+ L2derivDistr.0 = (1 - Exp(rate = 1))/scale,
+ FisherInfo.0 = matrix(1/scale^2,
+ dimnames = list("loc","loc")),
+ distrSymm = NoSymmetry(),
+ L2derivSymm = FunSymmList(NonSymmetric()),
+ L2derivDistrSymm = DistrSymmList(NoSymmetry()),
+ trafo = trafo, .returnClsName = "GumbelLocationFamily")
+ if(!is.function(trafo))
+ f.call <- substitute(GumbelLocationFamily(loc = l, scale = s,
+ trafo = matrix(Tr, dimnames = list("loc","loc"))),
+ list(l = loc, s = scale, Tr = trafo))
+ else
+ f.call <- substitute(GumbelLocationFamily(loc = l, scale = s, trafo = Tr),
+ list(l = loc, s = scale, Tr = trafo))
+ res at fam.call <- f.call
+ return(res)
+}
Added: branches/robast-0.9/pkg/ROptEstOld/R/Kurtosis.R
===================================================================
--- branches/robast-0.9/pkg/ROptEstOld/R/Kurtosis.R (rev 0)
+++ branches/robast-0.9/pkg/ROptEstOld/R/Kurtosis.R 2013-01-09 02:00:15 UTC (rev 526)
@@ -0,0 +1,24 @@
+###################################################################################
+#kurtosis --- code due to G. Jay Kerns, gkerns at ysu.edu
+###################################################################################
+
+
+
+setMethod("kurtosis", signature(x = "Gumbel"),
+ function(x, ...){
+ dots <- match.call(call = sys.call(sys.parent(1)),
+ expand.dots = FALSE)$"..."
+ fun <- NULL; cond <- NULL; low <- NULL; upp <- NULL
+ if(hasArg(low)) low <- dots$low
+ if(hasArg(upp)) upp <- dots$upp
+ if(hasArg(fun)||hasArg(cond)||!is.null(low)||!is.null(upp))
+ return(kurtosis(as(x,"AbscontDistribution"),...))
+ else{
+ return(12/5)
+# http://mathworld.wolfram.com/GumbelDistribution.html
+ }
+})
+
+### source http://en.wikipedia.org/wiki/Generalized_extreme_value_distribution
+### http://en.wikipedia.org/wiki/Gumbel_distribution
+### http://en.wikipedia.org/wiki/Riemann_zeta_function
Added: branches/robast-0.9/pkg/ROptEstOld/R/Skewness.R
===================================================================
--- branches/robast-0.9/pkg/ROptEstOld/R/Skewness.R (rev 0)
+++ branches/robast-0.9/pkg/ROptEstOld/R/Skewness.R 2013-01-09 02:00:15 UTC (rev 526)
@@ -0,0 +1,16 @@
+
+setMethod("skewness", signature(x = "Gumbel"),
+ function(x, ...){
+ dots <- match.call(call = sys.call(sys.parent(1)),
+ expand.dots = FALSE)$"..."
+ fun <- NULL; cond <- NULL; low <- NULL; upp <- NULL
+ if(hasArg(low)) low <- dots$low
+ if(hasArg(upp)) upp <- dots$upp
+ if(hasArg(fun)||hasArg(cond)||!is.null(low)||!is.null(upp))
+ return(skewness(as(x,"AbscontDistribution"),...))
+ else{
+ return( -12 * sqrt(6) * APERYCONSTANT / pi^3 )
+# http://mathworld.wolfram.com/GumbelDistribution.html
+ }
+})
+
Added: branches/robast-0.9/pkg/ROptEstOld/man/Gumbel-class.Rd
===================================================================
--- branches/robast-0.9/pkg/ROptEstOld/man/Gumbel-class.Rd (rev 0)
+++ branches/robast-0.9/pkg/ROptEstOld/man/Gumbel-class.Rd 2013-01-09 02:00:15 UTC (rev 526)
@@ -0,0 +1,158 @@
+\name{Gumbel-class}
+\docType{class}
+\alias{Gumbel-class}
+\alias{initialize,Gumbel-method}
+\alias{loc,Gumbel-method}
+\alias{loc<-,Gumbel-method}
+\alias{scale,Gumbel-method}
+\alias{scale<-,Gumbel-method}
+\alias{+,Gumbel,numeric-method}
+\alias{*,Gumbel,numeric-method}
+\alias{E}
+\alias{E-methods}
+\alias{E,Gumbel,missing,missing-method}
+\alias{var}
+\alias{var-methods}
+\alias{var,Gumbel-method}
+\alias{skewness}
+\alias{skewness-methods}
+\alias{skewness,Gumbel-method}
+\alias{kurtosis}
+\alias{kurtosis-methods}
+\alias{kurtosis,Gumbel-method}
+
+\title{Gumbel distribution}
+\description{The Gumbel cumulative distribution function with
+ location parameter \code{loc} \eqn{= \mu}{= mu} and scale
+ parameter \code{scale} \eqn{= \sigma}{= sigma} is
+ \deqn{F(x) = \exp(-\exp[-(x-\mu)/\sigma])}{F(x) = exp(-exp[-(x-mu)/sigma])}
+ for all real x, where \eqn{\sigma > 0}{sigma > 0};
+ c.f. \code{rgumbel}. This distribution is also known as
+ extreme value distribution of type I; confer Chapter~22 of
+ Johnson et al. (1995).
+}
+\section{Objects from the Class}{
+ Objects can be created by calls of the form \code{new("Gumbel", loc, scale)}.
+ More frequently they are created via the generating function
+ \code{Gumbel}.
+}
+\section{Slots}{
+ \describe{
+ \item{\code{img}}{Object of class \code{"Reals"}. }
+ \item{\code{param}}{Object of class \code{"GumbelParameter"}. }
+ \item{\code{r}}{\code{rgumbel}}
+ \item{\code{d}}{\code{dgumbel}}
+ \item{\code{p}}{\code{pgumbel}}
+ \item{\code{q}}{\code{qgumbel}}
+ \item{\code{gaps}}{(numeric) matrix or \code{NULL}}
+ \item{\code{.withArith}}{logical: used internally to issue warnings as to
+ interpretation of arithmetics}
+ \item{\code{.withSim}}{logical: used internally to issue warnings as to
+ accuracy}
+ \item{\code{.logExact}}{logical: used internally to flag the case where
+ there are explicit formulae for the log version of density, cdf, and
+ quantile function}
+ \item{\code{.lowerExact}}{logical: used internally to flag the case where
+ there are explicit formulae for the lower tail version of cdf and quantile
+ function}
+ \item{\code{Symmetry}}{object of class \code{"DistributionSymmetry"};
+ used internally to avoid unnecessary calculations.}
+ }
+}
+\section{Extends}{
+Class \code{"AbscontDistribution"}, directly.\cr
+Class \code{"UnivariateDistribution"}, by class \code{"AbscontDistribution"}.\cr
+Class \code{"Distribution"}, by class \code{"AbscontDistribution"}.
+}
+\section{Methods}{
+ \describe{
+ \item{initialize}{\code{signature(.Object = "Gumbel")}: initialize method. }
+
+ \item{loc}{\code{signature(object = "Gumbel")}: wrapped access method for
+ slot \code{loc} of slot \code{param}. }
+
+ \item{scale}{\code{signature(x = "Gumbel")}: wrapped access method for
+ slot \code{scale} of slot \code{param}. }
+
+ \item{loc<-}{\code{signature(object = "Gumbel")}: wrapped replace method for
+ slot \code{loc} of slot \code{param}. }
+
+ \item{scale<-}{\code{signature(x = "Gumbel")}: wrapped replace method for
+ slot \code{scale} of slot \code{param}. }
+
+ \item{\code{+}}{\code{signature(e1 = "Gumbel", e2 = "numeric")}: result again of
+ class \code{"Gumbel"}; exact. }
+
+ \item{\code{*}}{\code{signature(e1 = "Gumbel", e2 = "numeric")}: result again of
+ class \code{"Gumbel"}; exact. }
+
+ \item{E}{\code{signature(object = "Gumbel", fun = "missing", cond = "missing")}:
+ exact evaluation of expectation using explicit expressions.}
+
+ \item{var}{\code{signature(x = "Gumbel")}:
+ exact evaluation of expectation using explicit expressions.}
+
+ \item{skewness}{\code{signature(x = "Gumbel")}:
+ exact evaluation of expectation using explicit expressions.}
+
+ \item{kurtosis}{\code{signature(x = "Gumbel")}:
+ exact evaluation of expectation using explicit expressions.}
+
+ \item{median}{\code{signature(x = "Gumbel")}:
+ exact evaluation of expectation using explicit expressions.}
+
+ \item{IQR}{\code{signature(x = "Gumbel")}:
+ exact evaluation of expectation using explicit expressions.}
+ }
+}
+\usage{
+E(object, fun, cond, ...)
+\S4method{E}{Gumbel,missing,missing}(object, low = NULL, upp = NULL, ...)
+var(x, ...)
+\S4method{var}{Gumbel}(x, ...)
+skewness(x, ...)
+\S4method{skewness}{Gumbel}(x, ...)
+kurtosis(x, ...)
+\S4method{kurtosis}{Gumbel}(x, ...)
+
+}
+\arguments{
+ \item{object}{ object of class \code{"Distribution"}}
+ \item{fun}{ if missing the (conditional) expectation is computed
+ else the (conditional) expection of \code{fun} is computed. }
+ \item{cond}{ if not missing the conditional expectation
+ given \code{cond} is computed. }
+ \item{Nsim}{ number of MC simulations used to determine the expectation. }
+ \item{rel.tol}{relative tolerance for \code{distrExIntegrate}.}
+ \item{low}{lower bound of integration range.}
+ \item{upp}{upper bound of integration range.}
+ \item{lowerTruncQuantile}{lower quantile for quantile based integration range.}
+ \item{upperTruncQuantile}{upper quantile for quantile based integration range.}
+ \item{IQR.fac}{factor for scale based integration range (i.e.;
+ median of the distribution \eqn{\pm}{+-}\code{IQR.fac}\eqn{\times}{*}IQR).}
+ \item{\dots}{ additional arguments to \code{fun} }
+ \item{useApply}{ logical: should \code{sapply}, respectively \code{apply}
+ be used to evaluate \code{fun}. }
+ \item{withCond}{ logical: is \code{cond} in the argument list of \code{fun}. }
+}
+
+
+\references{Johnson et al. (1995) \emph{Continuous Univariate Distributions. Vol. 2. 2nd ed.}
+ New York: Wiley.}
+\author{Matthias Kohl \email{Matthias.Kohl at stamats.de}}
+\note{This class is based on the code provided by the package \pkg{evd}.}
+\seealso{\code{\link[evd:gumbel]{rgumbel}}, \code{\link[distr]{AbscontDistribution-class}}}
+\examples{
+(G1 <- new("Gumbel", loc = 1, scale = 2))
+plot(G1)
+loc(G1)
+scale(G1)
+loc(G1) <- -1
+scale(G1) <- 2
+plot(G1)
+}
+\concept{Gumbel}
+\keyword{distribution}
+\concept{extreme value distribution}
+\concept{absolutely continuous distribution}
+\concept{S4 distribution class}
Added: branches/robast-0.9/pkg/ROptEstOld/man/Gumbel.Rd
===================================================================
--- branches/robast-0.9/pkg/ROptEstOld/man/Gumbel.Rd (rev 0)
+++ branches/robast-0.9/pkg/ROptEstOld/man/Gumbel.Rd 2013-01-09 02:00:15 UTC (rev 526)
@@ -0,0 +1,43 @@
+\name{Gumbel}
+\alias{Gumbel}
+
+\title{Generating function for Gumbel-class}
+\description{
+ Generates an object of class \code{"Gumbel"}.
+}
+\usage{Gumbel(loc = 0, scale = 1)}
+\arguments{
+ \item{loc}{ real number: location parameter of
+ the Gumbel distribution. }
+ \item{scale}{ positive real number: scale parameter
+ of the Gumbel distribution }
+}
+%\details{}
+\value{Object of class \code{"Gumbel"}}
+%\references{}
+\author{Matthias Kohl \email{Matthias.Kohl at stamats.de}}
+\note{The class \code{"Gumbel"} is based on the code provided
+ by the package \pkg{evd}.}
+\seealso{\code{\link{Gumbel-class}}, \code{\link[evd:gumbel]{rgumbel}}}
+\examples{
+(G1 <- Gumbel(loc = 1, scale = 2))
+plot(G1)
+loc(G1)
+scale(G1)
+loc(G1) <- -1
+scale(G1) <- 2
+plot(G1)
+
+E(Gumbel()) # Euler's constant
+E(G1, function(x){x^2})
+
+## The function is currently defined as
+function(loc = 0, scale = 1){
+ new("Gumbel", loc = loc, scale = scale)
+}
+}
+\concept{Gumbel}
+\keyword{distribution}
+\concept{absolutely continuous distribution}
+\concept{Gumbel distribution}
+\concept{generating function}
Modified: branches/robast-0.9/pkg/ROptEstOld/man/GumbelLocationFamily.Rd
===================================================================
--- branches/robast-0.9/pkg/ROptEstOld/man/GumbelLocationFamily.Rd 2012-11-05 07:50:51 UTC (rev 525)
+++ branches/robast-0.9/pkg/ROptEstOld/man/GumbelLocationFamily.Rd 2013-01-09 02:00:15 UTC (rev 526)
@@ -25,7 +25,7 @@
}
\author{Matthias Kohl \email{Matthias.Kohl at stamats.de}}
%\note{}
-\seealso{\code{\link{L2ParamFamily-class}}, \code{\link[distrEx]{Gumbel-class}}}
+\seealso{\code{\link{L2ParamFamily-class}}, \code{\link{Gumbel-class}}}
\examples{
distrExOptions("ElowerTruncQuantile" = 1e-15) # problem with
# non-finite function value
Added: branches/robast-0.9/pkg/ROptEstOld/man/GumbelParameter-class.Rd
===================================================================
--- branches/robast-0.9/pkg/ROptEstOld/man/GumbelParameter-class.Rd (rev 0)
+++ branches/robast-0.9/pkg/ROptEstOld/man/GumbelParameter-class.Rd 2013-01-09 02:00:15 UTC (rev 526)
@@ -0,0 +1,57 @@
+\name{GumbelParameter-class}
+\docType{class}
+\alias{GumbelParameter-class}
+\alias{loc}
+\alias{loc,GumbelParameter-method}
+\alias{loc<-}
+\alias{loc<-,GumbelParameter-method}
+\alias{scale,GumbelParameter-method}
+\alias{scale<-,GumbelParameter-method}
+
+\title{Paramter of Gumbel distributions}
+\description{The class of the parameter of Gumbel distributions.}
+\section{Objects from the Class}{
+Objects can be created by calls of the form \code{new("GumbelParameter", ...)}.
+}
+\section{Slots}{
+ \describe{
+ \item{\code{loc}}{ real number: location parameter of
+ a Gumbel distribution. }
+ \item{\code{scale}}{ positive real number: scale
+ parameter of a Gumbel distribution. }
+ \item{\code{name}}{ default name is
+ \dQuote{parameter of a Gumbel distribution}. }
+ }
+}
+\section{Extends}{
+Class \code{"Parameter"}, directly.\cr
+Class \code{"OptionalParameter"}, by class \code{"Parameter"}.
+}
+\section{Methods}{
+ \describe{
+ \item{loc}{\code{signature(object = "GumbelParameter")}: access method for
+ slot \code{loc}. }
+ \item{scale}{\code{signature(x = "GumbelParameter")}: access method for
+ slot \code{scale}. }
+ \item{loc<-}{\code{signature(object = "GumbelParameter")}: replace method for
+ slot \code{loc}. }
+ \item{scale<-}{\code{signature(x = "GumbelParameter")}: replace method for
+ slot \code{scale}. }
+ }
+}
+%\references{}
+\author{Matthias Kohl \email{Matthias.Kohl at stamats.de}}
+%\note{}
+\seealso{\code{\link{Gumbel-class}}, \code{\link[distr]{Parameter-class}}}
+\examples{
+new("GumbelParameter")
+}
+\concept{Gumbel distribution}
+\keyword{distribution}
+\concept{parameter}
+\concept{S4 parameter class}
+\keyword{models}
+\concept{generating function}
+\concept{scale}
+\concept{location}
+\concept{location scale model}
Added: branches/robast-0.9/pkg/ROptEstOld/man/ROptEstOldConstants.Rd
===================================================================
--- branches/robast-0.9/pkg/ROptEstOld/man/ROptEstOldConstants.Rd (rev 0)
+++ branches/robast-0.9/pkg/ROptEstOld/man/ROptEstOldConstants.Rd 2013-01-09 02:00:15 UTC (rev 526)
@@ -0,0 +1,34 @@
+\name{ROptEstOldConstants}
+\alias{EULERMASCHERONICONSTANT}
+\alias{APERYCONSTANT}
+\encoding{latin1}
+\title{Built-in Constants in package ROptEstOld}
+\description{
+ Constants built into \pkg{ROptEstOld}.
+}
+\usage{
+EULERMASCHERONICONSTANT
+APERYCONSTANT
+}
+\details{
+ \pkg{ROptEstOld} has a small number of built-in constants.
+
+ The following constants are available:
+ \itemize{
+ \item \code{EULERMASCHERONICONSTANT}: the Euler Mascheroni constant
+ \deqn{\gamma=-\Gamma'(1)}{gamma=-digamma(1)}
+ given in \url{http://mathworld.wolfram.com/Euler-MascheroniConstant.html} (48);
+ \item \code{APERYCONSTANT}: the \enc{Apéry}{Apery} constant
+ \deqn{\zeta(3)= \frac{5}{2} (\sum_{k\ge 1}\frac{(-1)^{k-1}}{k^3 {2k\choose k}})}{
+ zeta(3) = 5/2 sum_{k>=0} (-1)^(k-1)/(k^3 * choose(2k,k))}
+ as given in \url{http://mathworld.wolfram.com/AperysConstant.html}, equation (8);
+ }
+
+ These are implemented as variables in the \pkg{ROptEstOld} name space taking
+ appropriate values.
+}
+\examples{
+EULERMASCHERONICONSTANT
+APERYCONSTANT
+}
+\keyword{sysdata}
More information about the Robast-commits
mailing list