[Distr-commits] r468 - in branches/distr-2.2/pkg: distr/R distr/chm distr/man distrEx distrEx/R distrEx/chm distrEx/man distrTeach/demo
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Thu May 14 14:17:09 CEST 2009
Author: ruckdeschel
Date: 2009-05-14 14:17:07 +0200 (Thu, 14 May 2009)
New Revision: 468
Modified:
branches/distr-2.2/pkg/distr/R/ContDistribution.R
branches/distr-2.2/pkg/distr/chm/Distr.chm
branches/distr-2.2/pkg/distr/man/ContDistribution.Rd
branches/distr-2.2/pkg/distrEx/NAMESPACE
branches/distr-2.2/pkg/distrEx/R/AllClass.R
branches/distr-2.2/pkg/distrEx/R/AllInitialize.R
branches/distr-2.2/pkg/distrEx/R/Expectation.R
branches/distr-2.2/pkg/distrEx/R/Functionals.R
branches/distr-2.2/pkg/distrEx/R/Kurtosis.R
branches/distr-2.2/pkg/distrEx/R/Skewness.R
branches/distr-2.2/pkg/distrEx/chm/00Index.html
branches/distr-2.2/pkg/distrEx/chm/E.html
branches/distr-2.2/pkg/distrEx/chm/Pareto-class.html
branches/distr-2.2/pkg/distrEx/chm/Var.html
branches/distr-2.2/pkg/distrEx/chm/distrEx.chm
branches/distr-2.2/pkg/distrEx/chm/distrEx.hhp
branches/distr-2.2/pkg/distrEx/chm/distrEx.toc
branches/distr-2.2/pkg/distrEx/chm/distrExConstants.html
branches/distr-2.2/pkg/distrEx/chm/m1df.html
branches/distr-2.2/pkg/distrEx/chm/m2df.html
branches/distr-2.2/pkg/distrEx/man/0distrEx-package.Rd
branches/distr-2.2/pkg/distrEx/man/E.Rd
branches/distr-2.2/pkg/distrEx/man/Pareto-class.Rd
branches/distr-2.2/pkg/distrEx/man/Var.Rd
branches/distr-2.2/pkg/distrTeach/demo/illustCLT.R
branches/distr-2.2/pkg/distrTeach/demo/illustLLN.R
Log:
distrTeach: included options("device.ask.default"=FALSE) in demos to avoid the need to press a button between frames in the "movie"
distr: "abs" for ContDistribution now forces argument x --- caused errors in mad() for instance
distrEx: implemented GPareto class (Nataliya) [including functionals)
corrected some bug with match.call() in Var()...
Modified: branches/distr-2.2/pkg/distr/R/ContDistribution.R
===================================================================
--- branches/distr-2.2/pkg/distr/R/ContDistribution.R 2009-04-18 10:58:04 UTC (rev 467)
+++ branches/distr-2.2/pkg/distr/R/ContDistribution.R 2009-05-14 12:17:07 UTC (rev 468)
@@ -430,6 +430,7 @@
setMethod("abs", "AbscontDistribution",
function(x){
if (.isEqual(p(x)(0),0)) return(x)
+ x <- x
rnew <- function(n, ...){}
body(rnew) <- substitute({ abs(g(n, ...)) }, list(g = x at r))
@@ -556,8 +557,6 @@
.lowerExact = .lowerExact(x), .logExact = FALSE)
object
})
-aN=abs(N)
-q(aN)(-35,log=T,lower=F)
## exact: exp for absolutly continuous distributions
setMethod("exp", "AbscontDistribution",
Modified: branches/distr-2.2/pkg/distr/chm/Distr.chm
===================================================================
(Binary files differ)
Modified: branches/distr-2.2/pkg/distr/man/ContDistribution.Rd
===================================================================
--- branches/distr-2.2/pkg/distr/man/ContDistribution.Rd 2009-04-18 10:58:04 UTC (rev 467)
+++ branches/distr-2.2/pkg/distr/man/ContDistribution.Rd 2009-05-14 12:17:07 UTC (rev 468)
@@ -4,8 +4,6 @@
\title{Generating function "AbscontDistribution"}
\description{Generates an object of class \code{"AbscontDistribution"}}
-\synopsis{
-}
\usage{
AbscontDistribution(r = NULL, d = NULL, p = NULL, q = NULL,
gaps = NULL, param = NULL, img = new("Reals"),
Modified: branches/distr-2.2/pkg/distrEx/NAMESPACE
===================================================================
--- branches/distr-2.2/pkg/distrEx/NAMESPACE 2009-04-18 10:58:04 UTC (rev 467)
+++ branches/distr-2.2/pkg/distrEx/NAMESPACE 2009-05-14 12:17:07 UTC (rev 468)
@@ -13,7 +13,7 @@
"DiscreteCondDistribution",
"AbscontCondDistribution",
"Gumbel", "PrognCondition",
- "Pareto")
+ "Pareto", "GPareto")
exportMethods("initialize",
"show",
"plot",
@@ -29,6 +29,7 @@
"CvMDist")
exportMethods("support",
"cond",
+ "location", "location<-",
"Range",
"loc", "loc<-",
"scale", "scale<-",
@@ -44,7 +45,7 @@
export("LMParameter")
export("DiscreteMVDistribution",
"LMCondDistribution",
- "Gumbel", "Pareto")
+ "Gumbel", "Pareto", "GPareto")
export("ConvexContamination")
export("GLIntegrate",
"distrExIntegrate")
Modified: branches/distr-2.2/pkg/distrEx/R/AllClass.R
===================================================================
--- branches/distr-2.2/pkg/distrEx/R/AllClass.R 2009-04-18 10:58:04 UTC (rev 467)
+++ branches/distr-2.2/pkg/distrEx/R/AllClass.R 2009-05-14 12:17:07 UTC (rev 468)
@@ -206,3 +206,53 @@
contains = "AbscontDistribution"
)
+## Class: GParetoParameter
+setClass("GParetoParameter",
+ representation = representation(loc = "numeric", scale = "numeric", shape = "numeric"
+ ),
+ prototype = prototype(loc = 0, scale = 1, shape = 0, name =
+ gettext("Parameter of a generalized Pareto distribution")
+ ),
+ contains = "Parameter"
+ )
+## Class: Generalized Pareto distribution
+setClass("GPareto",
+ prototype = prototype(
+ r = function(n){ rgpd(n,loc = 0, scale = 1, shape = 1) },
+ d = function(x, log = FALSE){
+ dgpd(x, loc = 0, scale = 1, shape = 1, log = log)
+ },
+ p = function(q, lower.tail = TRUE, log.p = FALSE ){
+ p0 <- pgpd(q, loc = 0, scale = 1, shape = 1)
+ if(!lower.tail ) p0 <- 1-p0
+ if(log.p) p0 <- log(p0)
+ return(p0)},
+ q = function(p, lower.tail = TRUE, log.p = FALSE ){
+ ## P.R.: changed to vectorized form
+ p1 <- if(log.p) exp(p) else p
+ if(!lower.tail) p1 <- 1-p1
+
+ in01 <- (p1>1 | p1<0)
+ i01 <- .isEqual01(p1)
+ i0 <- (i01 & p1<1)
+ i1 <- (i01 & p1>0)
+ ii01 <- .isEqual01(p1) | in01
+
+ p0 <- p
+ p0[ii01] <- if(log.p) log(0.5) else 0.5
+
+ q1 <- qgpd(p0,loc=0, scale = 1, shape = 1)
+ q1[i0] <- if(lower.tail) -Inf else Inf
+ q1[i1] <- if(!lower.tail) -Inf else Inf
+ q1[in01] <- NaN
+
+ return(q1)
+ },
+ param = new("GParetoParameter"),
+ img = new("Reals"),
+ .withArith = FALSE,
+ .withSim = FALSE,
+ .logExact = TRUE,
+ .lowerExact = TRUE),
+ contains = "AbscontDistribution"
+ )
Modified: branches/distr-2.2/pkg/distrEx/R/AllInitialize.R
===================================================================
--- branches/distr-2.2/pkg/distrEx/R/AllInitialize.R 2009-04-18 10:58:04 UTC (rev 467)
+++ branches/distr-2.2/pkg/distrEx/R/AllInitialize.R 2009-05-14 12:17:07 UTC (rev 468)
@@ -92,3 +92,73 @@
.Object at .lowerExact <- TRUE
.Object
})
+
+## Class: Generalized Pareto distribution
+setMethod("initialize", "GPareto",
+ function(.Object, loc = 0, scale = 1, shape = 1) {
+ .Object at img <- new("Reals")
+ .Object at param <- new("GParetoParameter", loc = loc, scale = scale, shape = shape)
+ .Object at r <- function(n){}
+ .Object at d <- function(x, log = FALSE){}
+ .Object at p <- function(q, lower.tail = TRUE, log.p = FALSE){}
+ .Object at q <- function(p, lower.tail = TRUE, log.p = FALSE){}
+ body(.Object at r) <- substitute(
+ { rgpd(n, loc = locSub, scale = scaleSub, shape = shapeSub) },
+ list(locSub = loc, scaleSub = scale, shapeSub = shape)
+ )
+ body(.Object at d) <- substitute(
+ { dgpd(x, loc = locSub, scale = scaleSub, shape = shapeSub,
+ log = log) },
+ list(locSub = loc, scaleSub = scale, shapeSub = shape)
+ )
+ body(.Object at p) <- substitute(
+ { if(!lower.tail && log.p){
+ q0 <- (q-locSub)/scaleSub
+ return(-log(1+shapeSub*q0)/shapeSub)
+ }else{
+ p0 <- pgpd(q, loc = locSub, scale = scaleSub,
+ shape = shapeSub)
+ if(!lower.tail ) p0 <- 1-p0
+ if(log.p) p0 <- log(p0)
+ return(p0)}
+ }, list(locSub = loc, scaleSub = scale,
+ shapeSub = shape)
+ )
+ body(.Object at q) <- substitute({
+ if(!lower.tail && log.p){
+ p1 <- p
+ p1[p<.Machine$double.eps] <- 0.5
+ q0 <- (exp(-shapeSub*p1)-1)/shapeSub*scaleSub + locSub
+ q0[p<.Machine$double.eps] <- NaN
+ return(q0)
+ }else{
+
+ ## P.R.: changed to vectorized form
+ p1 <- if(log.p) exp(p) else p
+
+ in01 <- (p1>1 | p1<0)
+ i01 <- .isEqual01(p1)
+ i0 <- (i01 & p1<1)
+ i1 <- (i01 & p1>0)
+ ii01 <- .isEqual01(p1) | in01
+
+ p0 <- p
+ p0[ii01] <- if(log.p) log(0.5) else 0.5
+ if(!lower.tail) p0 <- 1-p0
+
+ q1 <- qgpd(p0, loc = locSub, scale = scaleSub,
+ shape = shapeSub)
+ q1[i0] <- if(lower.tail) locSub else Inf
+ q1[i1] <- if(!lower.tail) locSub else Inf
+ q1[in01] <- NaN
+
+ return(q1)
+ }
+ }, list(locSub = loc, scaleSub = scale, shapeSub = shape))
+
+ .Object at .withSim <- FALSE
+ .Object at .withArith <- FALSE
+ .Object at .logExact <- TRUE
+ .Object at .lowerExact <- TRUE
+ .Object
+ })
Modified: branches/distr-2.2/pkg/distrEx/R/Expectation.R
===================================================================
--- branches/distr-2.2/pkg/distrEx/R/Expectation.R 2009-04-18 10:58:04 UTC (rev 467)
+++ branches/distr-2.2/pkg/distrEx/R/Expectation.R 2009-05-14 12:17:07 UTC (rev 468)
@@ -741,7 +741,23 @@
})
## http://mathworld.wolfram.com/GumbelDistribution.html
+setMethod("E", signature(object = "GPareto",
+ fun = "missing",
+ cond = "missing"),
+ function(object, low = NULL, upp = NULL, ...){
+ if(!is.null(low)) if(low <= Min(object)) low <- NULL
+ k <- shape(object); s <- scale(object); mu <- loc(object)
+ if(is.null(low) && is.null(upp)){
+ if(k>=1) return(Inf)
+ else return(mu+s/(1-k))
+ }
+ else
+ return(E(as(object,"AbscontDistribution"), low=low, upp=upp, ...))
+ })
+### source http://en.wikipedia.org/wiki/Pareto_distribution
+
+
############################ Expectation for UnivarLebDecDistribution
### merged from Expectation_LebDec.R on Apr 15 2009
setMethod("E", signature(object = "UnivarLebDecDistribution",
Modified: branches/distr-2.2/pkg/distrEx/R/Functionals.R
===================================================================
--- branches/distr-2.2/pkg/distrEx/R/Functionals.R 2009-04-18 10:58:04 UTC (rev 467)
+++ branches/distr-2.2/pkg/distrEx/R/Functionals.R 2009-05-14 12:17:07 UTC (rev 468)
@@ -8,8 +8,8 @@
setMethod("var", signature(x = "UnivariateDistribution"),
function(x, fun = function(t) {t}, cond, withCond = FALSE, useApply = TRUE,
...){
- dots <- match.call(call = sys.call(sys.parent(1)),
- expand.dots = FALSE)$"..."
+ if(missing(useApply)) useApply <- TRUE
+ dots <- list(...)
low <- -Inf; upp <- Inf
if(hasArg(low)) low <- dots$low
if(hasArg(upp)) upp <- dots$upp
@@ -82,16 +82,16 @@
function(x, fun, cond, withCond = FALSE, useApply = TRUE, ...){
if(missing(fun))
{if(missing(cond))
- return(sqrt(var(x, useApply = TRUE, ...)))
+ return(sqrt(var(x, useApply = useApply, ...)))
else
- return(sqrt(var(x, cond = cond, withCond = FALSE, useApply = TRUE,
+ return(sqrt(var(x, cond = cond, withCond = FALSE, useApply = useApply,
...)))
}else{
if(missing(cond))
- return(sqrt(var(x, fun = fun, useApply = TRUE, ...)))
+ return(sqrt(var(x, fun = fun, useApply = useApply, ...)))
else
return(sqrt(var(x, fun = fun, cond = cond, withCond = FALSE,
- useApply = TRUE,...)))
+ useApply = useApply,...)))
}
})
@@ -102,14 +102,14 @@
{if(missing(cond))
return(sd(param(x)))
else
- return(sqrt(var(x, cond = cond, withCond = FALSE, useApply = TRUE,
+ return(sqrt(var(x, cond = cond, withCond = FALSE, useApply = useApply,
...)))}
else
{if(missing(cond))
- return(sqrt(var(x, fun = fun, useApply = TRUE, ...)))
+ return(sqrt(var(x, fun = fun, useApply = useApply, ...)))
else
return(sqrt(var(x, fun = fun, cond = cond, withCond = FALSE,
- useApply = TRUE,...)))}
+ useApply = useApply,...)))}
})
@@ -505,6 +505,21 @@
}})
## http://mathworld.wolfram.com/GumbelDistribution.html
+setMethod("var", signature(x = "GPareto"),
+ 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{ k <- shape(x); s <- scale(x)
+ if(k>=1/2) return(NA)
+ return(s^2/(1-k)^2/(1-2*k))
+ }})
+### source http://en.wikipedia.org/wiki/Pareto_distribution
+
#################################################################
# some exact medians
#################################################################
@@ -547,6 +562,10 @@
function(x) {a <- loc(x); b <- scale(x)
return(a - b *log(log(2)))
})
+setMethod("median", signature(x = "GPareto"),
+ function(x) {k <- shape(x); mu <- loc(x); s <- scale(x)
+ return(mu + s*(2^k-1)/k)
+ })
#################################################################
# some exact IQRs
@@ -588,6 +607,10 @@
function(x) { b <- scale(x)
return(b * (log(log(4))-log(log(4/3))))
})
+setMethod("IQR", signature(x = "GPareto"),
+ function(x) {k <- shape(x); s<- scale(x)
+ return(s/k*4^k*(1-3^(-k)))
+ })
#################################################################
# some exact mads
#################################################################
Modified: branches/distr-2.2/pkg/distrEx/R/Kurtosis.R
===================================================================
--- branches/distr-2.2/pkg/distrEx/R/Kurtosis.R 2009-04-18 10:58:04 UTC (rev 467)
+++ branches/distr-2.2/pkg/distrEx/R/Kurtosis.R 2009-05-14 12:17:07 UTC (rev 468)
@@ -443,3 +443,20 @@
}
})
+setMethod("kurtosis", signature(x = "GPareto"),
+ 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{
+ k <- shape(x)
+ if(k>=1/4) return(NA)
+ else
+ return( 3*(3+k+2*k^2)*(1-2*k)/(1-4*k)/(1-3*k)-3)
+ }
+})
+### source Maple ...
Modified: branches/distr-2.2/pkg/distrEx/R/Skewness.R
===================================================================
--- branches/distr-2.2/pkg/distrEx/R/Skewness.R 2009-04-18 10:58:04 UTC (rev 467)
+++ branches/distr-2.2/pkg/distrEx/R/Skewness.R 2009-05-14 12:17:07 UTC (rev 468)
@@ -404,4 +404,21 @@
}
})
+setMethod("skewness", signature(x = "GPareto"),
+ 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{
+ k <- shape(x)
+ if(k>=1/3) return(NA)
+ else
+ return( 2*(1+k)*sqrt(1-2*k)/(1-3*k) )
+ }
+})
+### source Maple...
Modified: branches/distr-2.2/pkg/distrEx/chm/00Index.html
===================================================================
--- branches/distr-2.2/pkg/distrEx/chm/00Index.html 2009-04-18 10:58:04 UTC (rev 467)
+++ branches/distr-2.2/pkg/distrEx/chm/00Index.html 2009-05-14 12:17:07 UTC (rev 468)
@@ -46,8 +46,12 @@
<h2><a name="">-- --</a></h2>
<table width="100%">
+<tr><td width="25%"><a href="GPareto-class.html">*,GPareto,numeric-method</a></td>
+<td>Generalized Pareto distribution</td></tr>
<tr><td width="25%"><a href="Gumbel-class.html">*,Gumbel,numeric-method</a></td>
<td>Gumbel distribution</td></tr>
+<tr><td width="25%"><a href="GPareto-class.html">+,GPareto,numeric-method</a></td>
+<td>Generalized Pareto distribution</td></tr>
<tr><td width="25%"><a href="Gumbel-class.html">+,Gumbel,numeric-method</a></td>
<td>Gumbel distribution</td></tr>
</table>
@@ -232,6 +236,8 @@
<td>Generic Function for the Computation of (Conditional) Expectations</td></tr>
<tr><td width="25%"><a href="E.html">E,Geom,missing,missing-method</a></td>
<td>Generic Function for the Computation of (Conditional) Expectations</td></tr>
+<tr><td width="25%"><a href="E.html">E,GPareto,missing,missing-method</a></td>
+<td>Generic Function for the Computation of (Conditional) Expectations</td></tr>
<tr><td width="25%"><a href="E.html">E,Gumbel,missing,missing-method</a></td>
<td>Generic Function for the Computation of (Conditional) Expectations</td></tr>
<tr><td width="25%"><a href="E.html">E,Hyper,missing,missing-method</a></td>
@@ -305,6 +311,12 @@
<td>Function to change the global variables of the package 'distrEx'</td></tr>
<tr><td width="25%"><a href="distrExOptions.html">GLIntegrateTruncQuantile</a></td>
<td>Function to change the global variables of the package 'distrEx'</td></tr>
+<tr><td width="25%"><a href="GPareto.html">GPareto</a></td>
+<td>Generating function for GPareto-class</td></tr>
+<tr><td width="25%"><a href="GPareto-class.html">GPareto-class</a></td>
+<td>Generalized Pareto distribution</td></tr>
+<tr><td width="25%"><a href="GParetoParameter-class.html">GParetoParameter-class</a></td>
+<td>Parameter of generalized Pareto distributions</td></tr>
<tr><td width="25%"><a href="Gumbel.html">Gumbel</a></td>
<td>Generating function for Gumbel-class</td></tr>
<tr><td width="25%"><a href="Gumbel-class.html">Gumbel-class</a></td>
@@ -351,6 +363,8 @@
<h2><a name="I">-- I --</a></h2>
<table width="100%">
+<tr><td width="25%"><a href="GPareto-class.html">initialize,GPareto-method</a></td>
+<td>Generalized Pareto distribution</td></tr>
<tr><td width="25%"><a href="Gumbel-class.html">initialize,Gumbel-method</a></td>
<td>Gumbel distribution</td></tr>
<tr><td width="25%"><a href="Pareto-class.html">initialize,Pareto-method</a></td>
@@ -381,6 +395,8 @@
<td>Generic Functions for the Computation of Functionals</td></tr>
<tr><td width="25%"><a href="Var.html">IQR,Geom-method</a></td>
<td>Generic Functions for the Computation of Functionals</td></tr>
+<tr><td width="25%"><a href="Var.html">IQR,GPareto-method</a></td>
+<td>Generic Functions for the Computation of Functionals</td></tr>
<tr><td width="25%"><a href="Var.html">IQR,Gumbel-method</a></td>
<td>Generic Functions for the Computation of Functionals</td></tr>
<tr><td width="25%"><a href="Var.html">IQR,Logis-method</a></td>
@@ -462,6 +478,8 @@
<td>Generic Functions for the Computation of Functionals</td></tr>
<tr><td width="25%"><a href="Var.html">kurtosis,Geom-method</a></td>
<td>Generic Functions for the Computation of Functionals</td></tr>
+<tr><td width="25%"><a href="Var.html">kurtosis,GPareto-method</a></td>
+<td>Generic Functions for the Computation of Functionals</td></tr>
<tr><td width="25%"><a href="Var.html">kurtosis,Gumbel-method</a></td>
<td>Generic Functions for the Computation of Functionals</td></tr>
<tr><td width="25%"><a href="Var.html">kurtosis,Hyper-method</a></td>
@@ -505,16 +523,32 @@
<td>Parameter of a linear regression model</td></tr>
<tr><td width="25%"><a href="GumbelParameter-class.html">loc</a></td>
<td>Paramter of Gumbel distributions</td></tr>
+<tr><td width="25%"><a href="GPareto-class.html">loc,GPareto-method</a></td>
+<td>Generalized Pareto distribution</td></tr>
+<tr><td width="25%"><a href="GParetoParameter-class.html">loc,GParetoParameter-method</a></td>
+<td>Parameter of generalized Pareto distributions</td></tr>
<tr><td width="25%"><a href="Gumbel-class.html">loc,Gumbel-method</a></td>
<td>Gumbel distribution</td></tr>
<tr><td width="25%"><a href="GumbelParameter-class.html">loc,GumbelParameter-method</a></td>
<td>Paramter of Gumbel distributions</td></tr>
<tr><td width="25%"><a href="GumbelParameter-class.html">loc<-</a></td>
<td>Paramter of Gumbel distributions</td></tr>
+<tr><td width="25%"><a href="GPareto-class.html">loc<-,GPareto-method</a></td>
+<td>Generalized Pareto distribution</td></tr>
+<tr><td width="25%"><a href="GParetoParameter-class.html">loc<-,GParetoParameter-method</a></td>
+<td>Parameter of generalized Pareto distributions</td></tr>
<tr><td width="25%"><a href="Gumbel-class.html">loc<-,Gumbel-method</a></td>
<td>Gumbel distribution</td></tr>
<tr><td width="25%"><a href="GumbelParameter-class.html">loc<-,GumbelParameter-method</a></td>
<td>Paramter of Gumbel distributions</td></tr>
+<tr><td width="25%"><a href="GPareto-class.html">location,GPareto-method</a></td>
+<td>Generalized Pareto distribution</td></tr>
+<tr><td width="25%"><a href="GParetoParameter-class.html">location,GParetoParameter-method</a></td>
+<td>Parameter of generalized Pareto distributions</td></tr>
+<tr><td width="25%"><a href="GPareto-class.html">location<-,GPareto-method</a></td>
+<td>Generalized Pareto distribution</td></tr>
+<tr><td width="25%"><a href="GParetoParameter-class.html">location<-,GParetoParameter-method</a></td>
+<td>Parameter of generalized Pareto distributions</td></tr>
</table>
<h2><a name="M">-- M --</a></h2>
@@ -550,6 +584,8 @@
<td>Generic function for the computation of clipped second moments</td></tr>
<tr><td width="25%"><a href="m2df.html">m2df,AbscontDistribution-method</a></td>
<td>Generic function for the computation of clipped second moments</td></tr>
+<tr><td width="25%"><a href="m2df.html">m2df,AffLinDistribution-method</a></td>
+<td>Generic function for the computation of clipped second moments</td></tr>
<tr><td width="25%"><a href="m2df.html">m2df,Binom-method</a></td>
<td>Generic function for the computation of clipped second moments</td></tr>
<tr><td width="25%"><a href="m2df.html">m2df,Chisq-method</a></td>
@@ -634,6 +670,8 @@
<td>Generic Functions for the Computation of Functionals</td></tr>
<tr><td width="25%"><a href="Var.html">median,Geom-method</a></td>
<td>Generic Functions for the Computation of Functionals</td></tr>
+<tr><td width="25%"><a href="Var.html">median,GPareto-method</a></td>
+<td>Generic Functions for the Computation of Functionals</td></tr>
<tr><td width="25%"><a href="Var.html">median,Gumbel-method</a></td>
<td>Generic Functions for the Computation of Functionals</td></tr>
<tr><td width="25%"><a href="Var.html">median,Lnorm-method</a></td>
@@ -751,10 +789,18 @@
<h2><a name="S">-- S --</a></h2>
<table width="100%">
+<tr><td width="25%"><a href="GPareto-class.html">scale,GPareto-method</a></td>
+<td>Generalized Pareto distribution</td></tr>
+<tr><td width="25%"><a href="GParetoParameter-class.html">scale,GParetoParameter-method</a></td>
+<td>Parameter of generalized Pareto distributions</td></tr>
<tr><td width="25%"><a href="Gumbel-class.html">scale,Gumbel-method</a></td>
<td>Gumbel distribution</td></tr>
<tr><td width="25%"><a href="GumbelParameter-class.html">scale,GumbelParameter-method</a></td>
<td>Paramter of Gumbel distributions</td></tr>
+<tr><td width="25%"><a href="GPareto-class.html">scale<-,GPareto-method</a></td>
+<td>Generalized Pareto distribution</td></tr>
+<tr><td width="25%"><a href="GParetoParameter-class.html">scale<-,GParetoParameter-method</a></td>
+<td>Parameter of generalized Pareto distributions</td></tr>
<tr><td width="25%"><a href="Gumbel-class.html">scale<-,Gumbel-method</a></td>
<td>Gumbel distribution</td></tr>
<tr><td width="25%"><a href="GumbelParameter-class.html">scale<-,GumbelParameter-method</a></td>
@@ -769,12 +815,20 @@
<td>Generic Functions for the Computation of Functionals</td></tr>
<tr><td width="25%"><a href="ParetoParameter-class.html">shape</a></td>
<td>Paramter of Pareto distributions</td></tr>
+<tr><td width="25%"><a href="GPareto-class.html">shape,GPareto-method</a></td>
+<td>Generalized Pareto distribution</td></tr>
+<tr><td width="25%"><a href="GParetoParameter-class.html">shape,GParetoParameter-method</a></td>
+<td>Parameter of generalized Pareto distributions</td></tr>
<tr><td width="25%"><a href="Pareto-class.html">shape,Pareto-method</a></td>
<td>Pareto distribution</td></tr>
<tr><td width="25%"><a href="ParetoParameter-class.html">shape,ParetoParameter-method</a></td>
<td>Paramter of Pareto distributions</td></tr>
<tr><td width="25%"><a href="ParetoParameter-class.html">shape<-</a></td>
<td>Paramter of Pareto distributions</td></tr>
+<tr><td width="25%"><a href="GPareto-class.html">shape<-,GPareto-method</a></td>
+<td>Generalized Pareto distribution</td></tr>
+<tr><td width="25%"><a href="GParetoParameter-class.html">shape<-,GParetoParameter-method</a></td>
+<td>Parameter of generalized Pareto distributions</td></tr>
<tr><td width="25%"><a href="Pareto-class.html">shape<-,Pareto-method</a></td>
<td>Pareto distribution</td></tr>
<tr><td width="25%"><a href="ParetoParameter-class.html">shape<-,ParetoParameter-method</a></td>
@@ -823,6 +877,8 @@
<td>Generic Functions for the Computation of Functionals</td></tr>
<tr><td width="25%"><a href="Var.html">skewness,Geom-method</a></td>
<td>Generic Functions for the Computation of Functionals</td></tr>
+<tr><td width="25%"><a href="Var.html">skewness,GPareto-method</a></td>
+<td>Generic Functions for the Computation of Functionals</td></tr>
<tr><td width="25%"><a href="Var.html">skewness,Gumbel-method</a></td>
<td>Generic Functions for the Computation of Functionals</td></tr>
<tr><td width="25%"><a href="Var.html">skewness,Hyper-method</a></td>
@@ -932,6 +988,8 @@
<td>Generic Functions for the Computation of Functionals</td></tr>
<tr><td width="25%"><a href="Var.html">var,Geom-method</a></td>
<td>Generic Functions for the Computation of Functionals</td></tr>
+<tr><td width="25%"><a href="Var.html">var,GPareto-method</a></td>
+<td>Generic Functions for the Computation of Functionals</td></tr>
<tr><td width="25%"><a href="Var.html">var,Gumbel-method</a></td>
<td>Generic Functions for the Computation of Functionals</td></tr>
<tr><td width="25%"><a href="Var.html">var,Hyper-method</a></td>
Modified: branches/distr-2.2/pkg/distrEx/chm/E.html
===================================================================
--- branches/distr-2.2/pkg/distrEx/chm/E.html 2009-04-18 10:58:04 UTC (rev 467)
+++ branches/distr-2.2/pkg/distrEx/chm/E.html 2009-05-14 12:17:07 UTC (rev 468)
@@ -48,6 +48,7 @@
<param name="keyword" value="R: E,Gammad,missing,missing-method">
<param name="keyword" value="R: E,Geom,missing,missing-method">
<param name="keyword" value="R: E,Gumbel,missing,missing-method">
+<param name="keyword" value="R: E,GPareto,missing,missing-method">
<param name="keyword" value="R: E,Hyper,missing,missing-method">
<param name="keyword" value="R: E,Logis,missing,missing-method">
<param name="keyword" value="R: E,Lnorm,missing,missing-method">
@@ -231,6 +232,8 @@
E(object, low = NULL, upp = NULL, ...)
## S4 method for signature 'Gumbel, missing, missing':
E(object, low = NULL, upp = NULL, ...)
+## S4 method for signature 'GPareto, missing, missing':
+E(object, low = NULL, upp = NULL, ...)
## S4 method for signature 'Hyper, missing, missing':
E(object, low = NULL, upp = NULL, ...)
## S4 method for signature 'Logis, missing, missing':
@@ -440,8 +443,9 @@
<dt>object = "Exp", fun = "missing", cond = "missing":</dt><dd>exact evaluation using explicit expressions.</dd>
<dt>object = "Fd", fun = "missing", cond = "missing":</dt><dd>exact evaluation using explicit expressions.</dd>
<dt>object = "Gammad", fun = "missing", cond = "missing":</dt><dd>exact evaluation using explicit expressions.</dd>
+<dt>object = "Geom", fun = "missing", cond = "missing":</dt><dd>exact evaluation using explicit expressions.</dd>
<dt>object = "Gumbel", fun = "missing", cond = "missing":</dt><dd>exact evaluation using explicit expressions.</dd>
-<dt>object = "Geom", fun = "missing", cond = "missing":</dt><dd>exact evaluation using explicit expressions.</dd>
+<dt>object = "GPareto", fun = "missing", cond = "missing":</dt><dd>exact evaluation using explicit expressions.</dd>
<dt>object = "Hyper", fun = "missing", cond = "missing":</dt><dd>exact evaluation using explicit expressions.</dd>
<dt>object = "Logis", fun = "missing", cond = "missing":</dt><dd>exact evaluation using explicit expressions.</dd>
<dt>object = "Lnorm", fun = "missing", cond = "missing":</dt><dd>exact evaluation using explicit expressions.</dd>
Modified: branches/distr-2.2/pkg/distrEx/chm/Pareto-class.html
===================================================================
--- branches/distr-2.2/pkg/distrEx/chm/Pareto-class.html 2009-04-18 10:58:04 UTC (rev 467)
+++ branches/distr-2.2/pkg/distrEx/chm/Pareto-class.html 2009-05-14 12:17:07 UTC (rev 468)
@@ -93,7 +93,19 @@
<dt>Min<-</dt><dd><code>signature(x = "Pareto")</code>: wrapped replace method for
slot <code>Min</code> of slot <code>param</code>. </dd>
-<p>
+
+<dt>E</dt><dd><code>signature(object = "Pareto", fun = "missing", cond = "missing")</code>:
+exact evaluation using explicit expressions.</dd>
+<dt>var</dt><dd><code>signature(signature(x = "Pareto")</code>:
+exact evaluation using explicit expressions.</dd>
+<dt>median</dt><dd><code>signature(signature(x = "Pareto")</code>:
+exact evaluation using explicit expressions.</dd>
+<dt>IQR</dt><dd><code>signature(signature(x = "Pareto")</code>:
+exact evaluation using explicit expressions.</dd>
+<dt>skewness</dt><dd><code>signature(signature(x = "Pareto")</code>:
+exact evaluation using explicit expressions.</dd>
+<dt>kurtosis</dt><dd><code>signature(signature(x = "Pareto")</code>:
+exact evaluation using explicit expressions.</dd>
</dl>
<h3>Note</h3>
Modified: branches/distr-2.2/pkg/distrEx/chm/Var.html
===================================================================
--- branches/distr-2.2/pkg/distrEx/chm/Var.html 2009-04-18 10:58:04 UTC (rev 467)
+++ branches/distr-2.2/pkg/distrEx/chm/Var.html 2009-05-14 12:17:07 UTC (rev 468)
@@ -26,6 +26,7 @@
<param name="keyword" value="R: var,Gammad-method">
<param name="keyword" value="R: var,Geom-method">
<param name="keyword" value="R: var,Gumbel-method">
+<param name="keyword" value="R: var,GPareto-method">
<param name="keyword" value="R: var,Hyper-method">
<param name="keyword" value="R: var,Logis-method">
<param name="keyword" value="R: var,Lnorm-method">
@@ -56,6 +57,7 @@
<param name="keyword" value="R: median,Exp-method">
<param name="keyword" value="R: median,Geom-method">
<param name="keyword" value="R: median,Gumbel-method">
+<param name="keyword" value="R: median,GPareto-method">
<param name="keyword" value="R: median,Logis-method">
<param name="keyword" value="R: median,Lnorm-method">
<param name="keyword" value="R: median,Norm-method">
@@ -78,6 +80,7 @@
<param name="keyword" value="R: IQR,Exp-method">
<param name="keyword" value="R: IQR,Geom-method">
<param name="keyword" value="R: IQR,Gumbel-method">
+<param name="keyword" value="R: IQR,GPareto-method">
<param name="keyword" value="R: IQR,Logis-method">
<param name="keyword" value="R: IQR,Norm-method">
<param name="keyword" value="R: IQR,Pareto-method">
@@ -119,6 +122,7 @@
<param name="keyword" value="R: skewness,Gammad-method">
<param name="keyword" value="R: skewness,Geom-method">
<param name="keyword" value="R: skewness,Gumbel-method">
+<param name="keyword" value="R: skewness,GPareto-method">
<param name="keyword" value="R: skewness,Hyper-method">
<param name="keyword" value="R: skewness,Logis-method">
<param name="keyword" value="R: skewness,Lnorm-method">
@@ -149,6 +153,7 @@
<param name="keyword" value="R: kurtosis,Gammad-method">
<param name="keyword" value="R: kurtosis,Geom-method">
<param name="keyword" value="R: kurtosis,Gumbel-method">
+<param name="keyword" value="R: kurtosis,GPareto-method">
<param name="keyword" value="R: kurtosis,Hyper-method">
<param name="keyword" value="R: kurtosis,Logis-method">
<param name="keyword" value="R: kurtosis,Lnorm-method">
@@ -200,6 +205,8 @@
IQR(x)
[TRUNCATED]
To get the complete diff run:
svnlook diff /svnroot/distr -r 468
More information about the Distr-commits
mailing list