[Distr-commits] r677 - in branches/distr-2.3/pkg/distrEx: R man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Thu Sep 23 18:49:54 CEST 2010
Author: ruckdeschel
Date: 2010-09-23 18:49:54 +0200 (Thu, 23 Sep 2010)
New Revision: 677
Added:
branches/distr-2.3/pkg/distrEx/man/GEV-class.Rd
branches/distr-2.3/pkg/distrEx/man/GEVParameter-class.Rd
Modified:
branches/distr-2.3/pkg/distrEx/R/Expectation.R
branches/distr-2.3/pkg/distrEx/R/Kurtosis.R
branches/distr-2.3/pkg/distrEx/R/Skewness.R
branches/distr-2.3/pkg/distrEx/man/E.Rd
branches/distr-2.3/pkg/distrEx/man/Var.Rd
Log:
distrEx: fixed some buglets in GEV and completed unfinished documentation for GEV
Modified: branches/distr-2.3/pkg/distrEx/R/Expectation.R
===================================================================
--- branches/distr-2.3/pkg/distrEx/R/Expectation.R 2010-09-03 01:53:29 UTC (rev 676)
+++ branches/distr-2.3/pkg/distrEx/R/Expectation.R 2010-09-23 16:49:54 UTC (rev 677)
@@ -14,7 +14,6 @@
return(c(low=low,upp=upp))
}
-
## Integration of functions
setMethod("E", signature(object = "UnivariateDistribution",
fun = "missing",
@@ -870,30 +869,34 @@
){
dots <- list(...)
-
dots.withoutUseApply <- dots
useApply <- TRUE
if(!is.null(dots$useApply)) useApply <- dots$useApply
dots.withoutUseApply$useApply <- NULL
-
- integrand <- function(x, dfun, ...){di <- dim(x)
- y <- q(object)(x)##quantile transformation
- if(useApply){
- funy <- sapply(y,fun, ...)
- dim(y) <- di
- dim(funy) <- di
- }else funy <- fun(y,...)
+ integrand <- function(x, dfun, ...){ di <- dim(x)
+ y <- q(object)(x)##quantile transformation
+ if(useApply){
+ funy <- sapply(y,fun, ...)
+ dim(y) <- di
+ dim(funy) <- di
+ }else funy <- fun(y,...)
return(funy) }
- if(is.null(low)) low <- 0
- if(is.null(upp)) upp <- 1
+ if(is.null(low)) low <- -Inf
+ if(is.null(upp)) upp <- Inf
+
+ Ib <- .getIntbounds(object, low, upp, lowerTruncQuantile,
+ upperTruncQuantile, IQR.fac)
+ low <- p(object)(Ib["low"])
+ upp <- p(object)(Ib["upp"])
+ if(is.nan(low)) low <- 0
+ if(is.nan(upp)) upp <- 1
+ return(do.call(distrExIntegrate, c(list(f = integrand,
+ lower = low,
+ upper = upp,
+ rel.tol = rel.tol,
+ distr = object, dfun = dunif), dots.withoutUseApply)))
- Ib <- .getIntbounds(object, low, upp, lowerTruncQuantile,
- upperTruncQuantile, IQR.fac)
-
- return(do.call(distrExIntegrate, c(list(f = integrand,lower = low,
-upper = upp,rel.tol = rel.tol,distr = object, dfun = d(object)),dots.withoutUseApply)))
-
})
Modified: branches/distr-2.3/pkg/distrEx/R/Kurtosis.R
===================================================================
--- branches/distr-2.3/pkg/distrEx/R/Kurtosis.R 2010-09-03 01:53:29 UTC (rev 676)
+++ branches/distr-2.3/pkg/distrEx/R/Kurtosis.R 2010-09-23 16:49:54 UTC (rev 677)
@@ -161,7 +161,7 @@
if(hasArg(fun)||hasArg(cond)||!is.null(low)||!is.null(upp))
return(kurtosis(as(x,"AbscontDistribution"),...))
else
- return(2)
+ return(6)
})
### source http://mathworld.wolfram.com/ExponentialDistribution.html
@@ -473,8 +473,11 @@
else{
xi <- shape(x)
if(xi>=1/4) return(NA)
+ if(xi==0) return(12/5)
else
return((gamma(1-4*xi)- 4*gamma(1-xi)*gamma(1-3*xi)+6*gamma(1-2*xi)*gamma(1-xi)^2 - 3*gamma(1-xi)^4)/(gamma(1-2*xi)-gamma(1-xi)^2)^(2))
}
})
-## source http://en.wikipedia.org/wiki/Generalized_extreme_value_distribution
\ No newline at end of file
+### 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
Modified: branches/distr-2.3/pkg/distrEx/R/Skewness.R
===================================================================
--- branches/distr-2.3/pkg/distrEx/R/Skewness.R 2010-09-03 01:53:29 UTC (rev 676)
+++ branches/distr-2.3/pkg/distrEx/R/Skewness.R 2010-09-23 16:49:54 UTC (rev 677)
@@ -422,7 +422,7 @@
})
### source Maple...
-setMethod("skewness", signature(x = "GPareto"),
+setMethod("skewness", signature(x = "GEV"),
function(x, ...){
dots <- match.call(call = sys.call(sys.parent(1)),
expand.dots = FALSE)$"..."
@@ -434,10 +434,12 @@
else{
xi <- shape(x)
if(xi>=1/3) return(NA)
+ if(xi==0) return(APERYCONSTANT/pi^3*12*6^.5)
else
return((gamma(1-3*xi)-3*gamma(1-xi)*gamma(1-2*xi) + 2*gamma(1-xi)^3)/(gamma(1-2*xi)-gamma(1-xi)^2)^(3/2))
}
})
### 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
Modified: branches/distr-2.3/pkg/distrEx/man/E.Rd
===================================================================
--- branches/distr-2.3/pkg/distrEx/man/E.Rd 2010-09-03 01:53:29 UTC (rev 676)
+++ branches/distr-2.3/pkg/distrEx/man/E.Rd 2010-09-23 16:49:54 UTC (rev 677)
@@ -49,6 +49,8 @@
\alias{E,Gumbel,missing,missing-method}
\alias{E,GPareto,missing,missing-method}
\alias{E,GPareto,function,missing-method}
+\alias{E,GEV,missing,missing-method}
+\alias{E,GEV,function,missing-method}
\alias{E,Hyper,missing,missing-method}
\alias{E,Logis,missing,missing-method}
\alias{E,Lnorm,missing,missing-method}
Added: branches/distr-2.3/pkg/distrEx/man/GEV-class.Rd
===================================================================
--- branches/distr-2.3/pkg/distrEx/man/GEV-class.Rd (rev 0)
+++ branches/distr-2.3/pkg/distrEx/man/GEV-class.Rd 2010-09-23 16:49:54 UTC (rev 677)
@@ -0,0 +1,117 @@
+\name{GEV-class}
+\docType{class}
+\alias{GEV-class}
+\alias{initialize,GEV-method}
+\alias{loc,GEV-method}
+\alias{loc<-,GEV-method}
+\alias{location,GEV-method}
+\alias{location<-,GEV-method}
+\alias{scale,GEV-method}
+\alias{scale<-,GEV-method}
+\alias{shape,GEV-method}
+\alias{shape<-,GEV-method}
+\alias{+,GEV,numeric-method}
+\alias{*,GEV,numeric-method}
+
+
+\title{Generalized EV distribution}
+\description{[borrowed from \pkg{evd}]:
+
+ The (Three-parameter) generalized EV distribution with parameter \code{loc}\eqn{= a},
+ \code{scale} \eqn{= b}, \code{shape} \eqn{= c} has density:
+ \deqn{f(x) = \frac{1}{b} (1+c z)^(-1/c - 1), \quad z = \frac{x-a}{c}}
+ for \eqn{x > a} (\eqn{ c \geq 0}) and \eqn{a \leq x \leq a - b/c}(\eqn{c < 0}).
+
+ }
+\section{Objects from the Class}{
+ Objects can be created by calls of the form \code{new("GEV", loc, scale,shape)}.
+ More frequently they are created via the generating function
+ \code{GEV}.
+}
+\section{Slots}{
+ \describe{
+ \item{\code{img}}{Object of class \code{"Reals"}. }
+ \item{\code{param}}{Object of class \code{"GEVParameter"}. }
+ \item{\code{r}}{\code{rgpd}}
+ \item{\code{d}}{\code{dgpd}}
+ \item{\code{p}}{\code{pgpd}, but vectorized and with special treatment of
+ arguments \code{lower.tail} and \code{log.p}}
+ \item{\code{q}}{\code{qgpd}, but vectorized and with special treatment of
+ arguments \code{lower.tail} and \code{log.p}}
+ \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}
+ }
+}
+\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 = "GEV")}: initialize method. }
+
+ \item{shape}{\code{signature(object = "GEV")}: wrapped access method for
+ slot \code{shape} of slot \code{param}. }
+ \item{loc}{\code{signature(object = "GEV")}: wrapped access method for
+ slot \code{loc} of slot \code{param}. }
+ \item{location}{\code{signature(object = "GEV")}: alias to \code{loc},
+ to support argument naming of package \pkg{VGAM}. }
+ \item{scale}{\code{signature(x = "GEV")}: wrapped access method for
+ slot \code{scale} of slot \code{param}. }
+
+ \item{shape<-}{\code{signature(object = "GEV")}: wrapped replace method for
+ slot \code{shape} of slot \code{param}. }
+ \item{loc<-}{\code{signature(object = "GEV")}: wrapped replace method for
+ slot \code{loc} of slot \code{param}. }
+ \item{location<-}{\code{signature(object = "GEV")}: alias to \code{loc<-},
+ to support argument naming of package \pkg{VGAM}. }
+ \item{scale<-}{\code{signature(x = "GEV")}: wrapped replace method for
+ slot \code{scale} of slot \code{param}. }
+
+ \item{+}{\code{signature(e1 = "GEV", e2 = "numeric")}: exact method
+ for this transformation --- stays within this class. }
+ \item{*}{\code{signature(e1 = "GEV", e2 = "numeric")}: exact method
+ for this transformation --- stays within this class if \code{e2>0}. }
+
+ \item{E}{\code{signature(object = "GEV", fun = "missing", cond = "missing")}:
+ exact evaluation using explicit expressions.}
+ \item{var}{\code{signature(signature(x = "GEV")}:
+ exact evaluation using explicit expressions.}
+ \item{median}{\code{signature(signature(x = "GEV")}:
+ exact evaluation using explicit expressions.}
+ \item{IQR}{\code{signature(signature(x = "GEV")}:
+ exact evaluation using explicit expressions.}
+ \item{skewness}{\code{signature(signature(x = "GEV")}:
+ exact evaluation using explicit expressions.}
+ \item{kurtosis}{\code{signature(signature(x = "GEV")}:
+ exact evaluation using explicit expressions.}
+
+
+ }
+}
+\references{Pickands, J. (1975) \emph{Statistical inference using extreme order
+ statistics. _Annals of Statistics_, *3*, 119-131.}}
+\author{Nataliya Horbenko \email{Nataliya.Horbenko at itwm.fraunhofer.de}}
+\note{This class is based on the code provided by the package \pkg{evd}
+by A. G. Stephenson.}
+\seealso{\code{\link[evd:gpd]{dgpd}}, \code{\link[distr]{AbscontDistribution-class}}}
+\examples{
+(P1 <- new("GEV", loc = 0, scale = 1,shape = 0))
+plot(P1)
+shape(P1)
+loc(P1)
+scale(P1) <- 4
+loc(P1) <- 2
+plot(P1)
+}
+\concept{GEV}
+\keyword{distribution}
+\concept{extreme value distribution}
+\concept{absolutely continuous distribution}
+\concept{S4 distribution class}
Added: branches/distr-2.3/pkg/distrEx/man/GEVParameter-class.Rd
===================================================================
--- branches/distr-2.3/pkg/distrEx/man/GEVParameter-class.Rd (rev 0)
+++ branches/distr-2.3/pkg/distrEx/man/GEVParameter-class.Rd 2010-09-23 16:49:54 UTC (rev 677)
@@ -0,0 +1,67 @@
+\name{GEVParameter-class}
+\docType{class}
+\alias{GEVParameter-class}
+\alias{loc,GEVParameter-method}
+\alias{loc<-,GEVParameter-method}
+\alias{location,GEVParameter-method}
+\alias{location<-,GEVParameter-method}
+\alias{scale,GEVParameter-method}
+\alias{scale<-,GEVParameter-method}
+\alias{shape,GEVParameter-method}
+\alias{shape<-,GEVParameter-method}
+
+
+\title{Parameter of generalized Pareto distributions}
+\description{The class of the parameter of generalized Pareto distribution.}
+\section{Objects from the Class}{
+Objects can be created by calls of the form \code{new("GEVParameter", ...)}.
+}
+\section{Slots}{
+ \describe{
+ \item{\code{loc}}{ real number: location parameter of
+ a generalized Pareto distribution. }
+ \item{\code{scale}}{ real number: scale parameter of
+ a generalized Pareto distribution. }
+ \item{\code{shape}}{ real number: shape parameter of
+ a generalized Pareto distribution. }
+ \item{\code{name}}{ default name is
+ \dQuote{parameter of a GEV distribution}. }
+ }
+}
+\section{Extends}{
+Class \code{"Parameter"}, directly.\cr
+Class \code{"OptionalParameter"}, by class \code{"Parameter"}.
+}
+\section{Methods}{
+ \describe{
+ \item{loc}{\code{signature(object = "GEVParameter")}: access method for
+ slot \code{loc}. }
+ \item{location}{\code{signature(object = "GEVParameter")}: alias to \code{loc},
+ to support argument naming of package \pkg{VGAM}. }
+ \item{scale}{\code{signature(object = "GEVParameter")}: access method for
+ slot \code{scale}. }
+ \item{shape}{\code{signature(object = "GEVParameter")}: access method for
+ slot \code{shape}. }
+ \item{loc<-}{\code{signature(object = "GEVParameter")}: replace method for
+ slot \code{loc}. }
+ \item{location<-}{\code{signature(object = "GEVParameter")}: alias to \code{loc<-},
+ to support argument naming of package \pkg{VGAM}. }
+ \item{shape<-}{\code{signature(object = "GEVParameter")}: replace method for
+ slot \code{shape}. }
+ \item{shape<-}{\code{signature(object = "GEVParameter")}: replace method for
+ slot \code{shape}. }
+ }
+}
+%\references{}
+\author{Nataliya Horbenko \email{Nataliya.Horbenko at itwm.fraunhofer.de}}
+%\note{}
+\seealso{\code{\link{GEV-class}}, \code{\link[distr]{Parameter-class}}}
+\examples{
+new("GEVParameter")
+}
+\concept{GEV distribution}
+\keyword{distribution}
+\concept{parameter}
+\concept{S4 parameter class}
+\keyword{models}
+\concept{generating function}
Modified: branches/distr-2.3/pkg/distrEx/man/Var.Rd
===================================================================
--- branches/distr-2.3/pkg/distrEx/man/Var.Rd 2010-09-03 01:53:29 UTC (rev 676)
+++ branches/distr-2.3/pkg/distrEx/man/Var.Rd 2010-09-23 16:49:54 UTC (rev 677)
@@ -21,6 +21,7 @@
\alias{var,Geom-method}
\alias{var,Gumbel-method}
\alias{var,GPareto-method}
+\alias{var,GEV-method}
\alias{var,Hyper-method}
\alias{var,Logis-method}
\alias{var,Lnorm-method}
@@ -51,6 +52,7 @@
\alias{median,Exp-method}
\alias{median,Geom-method}
\alias{median,Gumbel-method}
+\alias{median,GEV-method}
\alias{median,GPareto-method}
\alias{median,Logis-method}
\alias{median,Lnorm-method}
@@ -75,6 +77,7 @@
\alias{IQR,Geom-method}
\alias{IQR,Gumbel-method}
\alias{IQR,GPareto-method}
+\alias{IQR,GEV-method}
\alias{IQR,Logis-method}
\alias{IQR,Norm-method}
\alias{IQR,Pareto-method}
@@ -116,6 +119,7 @@
\alias{skewness,Gammad-method}
\alias{skewness,Geom-method}
\alias{skewness,Gumbel-method}
+\alias{skewness,GEV-method}
\alias{skewness,GPareto-method}
\alias{skewness,Hyper-method}
\alias{skewness,Logis-method}
@@ -147,6 +151,7 @@
\alias{kurtosis,Gammad-method}
\alias{kurtosis,Geom-method}
\alias{kurtosis,Gumbel-method}
+\alias{kurtosis,GEV-method}
\alias{kurtosis,GPareto-method}
\alias{kurtosis,Hyper-method}
\alias{kurtosis,Logis-method}
@@ -177,6 +182,7 @@
\S4method{IQR}{Exp}(x)
\S4method{IQR}{Geom}(x)
\S4method{IQR}{Gumbel}(x)
+\S4method{IQR}{GEV}(x)
\S4method{IQR}{GPareto}(x)
\S4method{IQR}{Logis}(x)
\S4method{IQR}{Pareto}(x)
@@ -195,6 +201,7 @@
\S4method{median}{Exp}(x)
\S4method{median}{Geom}(x)
\S4method{median}{Gumbel}(x)
+\S4method{median}{GEV}(x)
\S4method{median}{GPareto}(x)
\S4method{median}{Logis}(x)
\S4method{median}{Lnorm}(x)
@@ -238,6 +245,7 @@
\S4method{var}{Gammad}(x, ...)
\S4method{var}{Geom}(x, ...)
\S4method{var}{Gumbel}(x, ...)
+\S4method{var}{GEV}(x, ...)
\S4method{var}{GPareto}(x, ...)
\S4method{var}{Hyper}(x, ...)
\S4method{var}{Logis}(x, ...)
@@ -265,6 +273,7 @@
\S4method{skewness}{Gammad}(x, ...)
\S4method{skewness}{Geom}(x, ...)
\S4method{skewness}{Gumbel}(x, ...)
+\S4method{skewness}{GEV}(x, ...)
\S4method{skewness}{GPareto}(x, ...)
\S4method{skewness}{Hyper}(x, ...)
\S4method{skewness}{Logis}(x, ...)
@@ -292,6 +301,7 @@
\S4method{kurtosis}{Gammad}(x, ...)
\S4method{kurtosis}{Geom}(x, ...)
\S4method{kurtosis}{Gumbel}(x, ...)
+\S4method{kurtosis}{GEV}(x, ...)
\S4method{kurtosis}{GPareto}(x, ...)
\S4method{kurtosis}{Hyper}(x, ...)
\S4method{kurtosis}{Logis}(x, ...)
@@ -421,6 +431,8 @@
exact evaluation using explicit expressions.}
\item{\code{var}, \code{signature(x = "GPareto")}:}{
exact evaluation using explicit expressions.}
+ \item{\code{var}, \code{signature(x = "GEV")}:}{
+ exact evaluation using explicit expressions.}
\item{\code{var}, \code{signature(x = "Hyper")}:}{
exact evaluation using explicit expressions.}
\item{\code{var}, \code{signature(x = "Logis")}:}{
@@ -458,6 +470,8 @@
exact evaluation using explicit expressions.}
\item{\code{IQR}, \code{signature(x = "GPareto")}:}{
exact evaluation using explicit expressions.}
+ \item{\code{IQR}, \code{signature(x = "GEV")}:}{
+ exact evaluation using explicit expressions.}
\item{\code{IQR}, \code{signature(x = "Logis")}:}{
exact evaluation using explicit expressions.}
\item{\code{IQR}, \code{signature(x = "Norm")}:}{
@@ -481,6 +495,8 @@
exact evaluation using explicit expressions.}
\item{\code{median}, \code{signature(x = "Gumbel")}:}{
exact evaluation using explicit expressions.}
+ \item{\code{median}, \code{signature(x = "GEV")}:}{
+ exact evaluation using explicit expressions.}
\item{\code{median}, \code{signature(x = "GPareto")}:}{
exact evaluation using explicit expressions.}
\item{\code{median}, \code{signature(x = "Logis")}:}{
@@ -537,6 +553,8 @@
exact evaluation using explicit expressions.}
\item{\code{skewness}, \code{signature(x = "Gumbel")}:}{
exact evaluation using explicit expressions.}
+ \item{\code{skewness}, \code{signature(x = "GEV")}:}{
+ exact evaluation using explicit expressions.}
\item{\code{skewness}, \code{signature(x = "GPareto")}:}{
exact evaluation using explicit expressions.}
\item{\code{skewness}, \code{signature(x = "Hyper")}:}{
@@ -584,6 +602,8 @@
exact evaluation using explicit expressions.}
\item{\code{kurtosis}, \code{signature(x = "Gumbel")}:}{
exact evaluation using explicit expressions.}
+ \item{\code{kurtosis}, \code{signature(x = "GEV")}:}{
+ exact evaluation using explicit expressions.}
\item{\code{kurtosis}, \code{signature(x = "GPareto")}:}{
exact evaluation using explicit expressions.}
\item{\code{kurtosis}, \code{signature(x = "Hyper")}:}{
More information about the Distr-commits
mailing list