[Distr-commits] r413 - in branches/distr-2.1/pkg: distr/R distr/chm distrEx distrEx/R distrEx/chm distrEx/man distrMod/R distrMod/chm distrMod/man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Wed Mar 18 22:18:17 CET 2009
Author: ruckdeschel
Date: 2009-03-18 22:18:17 +0100 (Wed, 18 Mar 2009)
New Revision: 413
Modified:
branches/distr-2.1/pkg/distr/R/UtilitiesDistributions.R
branches/distr-2.1/pkg/distr/chm/Distr.chm
branches/distr-2.1/pkg/distrEx/DESCRIPTION
branches/distr-2.1/pkg/distrEx/NAMESPACE
branches/distr-2.1/pkg/distrEx/R/AllClass.R
branches/distr-2.1/pkg/distrEx/R/AllInitialize.R
branches/distr-2.1/pkg/distrEx/R/AsymTotalVarDist.R
branches/distr-2.1/pkg/distrEx/R/Expectation.R
branches/distr-2.1/pkg/distrEx/R/Functionals.R
branches/distr-2.1/pkg/distrEx/R/Kurtosis.R
branches/distr-2.1/pkg/distrEx/R/Skewness.R
branches/distr-2.1/pkg/distrEx/chm/00Index.html
branches/distr-2.1/pkg/distrEx/chm/0distrEx-package.html
branches/distr-2.1/pkg/distrEx/chm/E.html
branches/distr-2.1/pkg/distrEx/chm/Var.html
branches/distr-2.1/pkg/distrEx/chm/distrEx.chm
branches/distr-2.1/pkg/distrEx/chm/distrEx.hhp
branches/distr-2.1/pkg/distrEx/chm/distrEx.toc
branches/distr-2.1/pkg/distrEx/man/0distrEx-package.Rd
branches/distr-2.1/pkg/distrEx/man/E.Rd
branches/distr-2.1/pkg/distrEx/man/Var.Rd
branches/distr-2.1/pkg/distrMod/R/modifyModel.R
branches/distr-2.1/pkg/distrMod/chm/distrMod.chm
branches/distr-2.1/pkg/distrMod/man/modifyModel-methods.Rd
Log:
distrEx: gains distribution Pareto; ported from pkg actuar by Nataliya Horbenko
distrMod: modifyModel gains argument .withL2derivDistr --- if false needs not be calculated (as e.g. this is done in a particular method calling the general method first...
Modified: branches/distr-2.1/pkg/distr/R/UtilitiesDistributions.R
===================================================================
--- branches/distr-2.1/pkg/distr/R/UtilitiesDistributions.R 2009-03-17 19:19:49 UTC (rev 412)
+++ branches/distr-2.1/pkg/distr/R/UtilitiesDistributions.R 2009-03-18 21:18:17 UTC (rev 413)
@@ -27,7 +27,8 @@
RtoDPQ <- function(r, e = getdistrOption("RtoDPQ.e"),
n = getdistrOption("DefaultNrGridPoints")){
zz <- r(10^e)
-
+ zz <- zz[!is.na(zz)]
+
dxy <- xy.coords(density(zz, n = n))
dfun <- .makeDNew(dxy$x, dxy$y, standM = "int")
Modified: branches/distr-2.1/pkg/distr/chm/Distr.chm
===================================================================
(Binary files differ)
Modified: branches/distr-2.1/pkg/distrEx/DESCRIPTION
===================================================================
--- branches/distr-2.1/pkg/distrEx/DESCRIPTION 2009-03-17 19:19:49 UTC (rev 412)
+++ branches/distr-2.1/pkg/distrEx/DESCRIPTION 2009-03-18 21:18:17 UTC (rev 413)
@@ -4,7 +4,7 @@
Title: Extensions of package distr
Description: Extensions of package distr and some additional
functionality
-Depends: R(>= 2.6.0), methods, distr(>= 2.0), evd, startupmsg
+Depends: R(>= 2.6.0), methods, distr(>= 2.0), evd, actuar, startupmsg
Suggests: tcltk
Author: Matthias Kohl, Peter Ruckdeschel
Maintainer: Matthias Kohl <Matthias.Kohl at stamats.de>
Modified: branches/distr-2.1/pkg/distrEx/NAMESPACE
===================================================================
--- branches/distr-2.1/pkg/distrEx/NAMESPACE 2009-03-17 19:19:49 UTC (rev 412)
+++ branches/distr-2.1/pkg/distrEx/NAMESPACE 2009-03-18 21:18:17 UTC (rev 413)
@@ -5,13 +5,15 @@
exportClasses("Condition", "EuclCondition")
exportClasses("LMParameter",
- "GumbelParameter")
+ "GumbelParameter",
+ "ParetoParameter")
exportClasses("MultivariateDistribution",
"DiscreteMVDistribution",
"UnivariateCondDistribution",
"DiscreteCondDistribution",
"AbscontCondDistribution",
- "Gumbel", "PrognCondition")
+ "Gumbel", "PrognCondition",
+ "Pareto")
exportMethods("initialize",
"show",
"plot",
@@ -25,11 +27,13 @@
"KolmogorovDist",
"HellingerDist",
"CvMDist")
-exportMethods("support",
+exportMethods("support",
"cond",
"Range",
"loc", "loc<-",
"scale", "scale<-",
+ "Min","shape",
+ "Min<-","shape<-",
"+", "*",
"name", "name<-",
"E", "var", "IQR", "skewness", "kurtosis",
@@ -40,7 +44,7 @@
export("LMParameter")
export("DiscreteMVDistribution",
"LMCondDistribution",
- "Gumbel")
+ "Gumbel", "Pareto")
export("ConvexContamination")
export("GLIntegrate",
"distrExIntegrate")
Modified: branches/distr-2.1/pkg/distrEx/R/AllClass.R
===================================================================
--- branches/distr-2.1/pkg/distrEx/R/AllClass.R 2009-03-17 19:19:49 UTC (rev 412)
+++ branches/distr-2.1/pkg/distrEx/R/AllClass.R 2009-03-18 21:18:17 UTC (rev 413)
@@ -100,12 +100,13 @@
# Gumbel distribution
setClass("Gumbel",
prototype = prototype(r = function(n){ rgumbel(n, loc = 0, scale = 1) },
- d = function(x, ...){ dgumbel(x, loc = 0, scale = 1, ...) },
- p = function(q, ...){ pgumbel(q, loc = 0, scale = 1, ...) },
- q = function(p, ...){
- mc <- as.list(match.call(call = sys.call())[-1])
- lower.tail <- mc$lower.tail
- if(is.null(lower.tail)) lower.tail <- TRUE
+ 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 <- if(log.p) exp(p) else p
in01 <- (p>1 | p<0)
i01 <- .isEqual01(p)
i0 <- (i01 & p<1)
@@ -120,7 +121,7 @@
},
img = new("Reals"),
param = new("GumbelParameter"),
- .logExact = TRUE,
+ .logExact = FALSE,
.lowerExact = TRUE),
contains = "AbscontDistribution")
@@ -145,3 +146,39 @@
stop("inifinite or missing value in 'scale'")
return(TRUE)
})
+
+
+###### Pareto distribution by Nataliya Horbenko, ITWM, 18-03-09
+## Class: ParetoParameter
+setClass("ParetoParameter",
+ representation = representation(shape = "numeric",
+ Min = "numeric"
+ ),
+ prototype = prototype(shape = 1, Min = 1, name =
+ gettext("Parameter of a Pareto distribution")
+ ),
+ contains = "Parameter"
+ )
+
+## Class: Pareto distribution
+setClass("Pareto",
+ prototype = prototype(
+ r = function(n){ rpareto1(n, shape = 1, min = 1) },
+ d = function(x, log = FALSE){
+ dpareto1(x, shape = 1, min = 1, log = log)
+ },
+ p = function(q, lower.tail = TRUE, log.p = FALSE ){
+ ppareto1(q, shape = 1, min = 1,
+ lower.tail = lower.tail, log.p = log.p)
+ },
+ q = function(p, lower.tail = TRUE, log.p = FALSE ){
+ qpareto1(p, shape = 1, min = 1,
+ lower.tail = lower.tail, log.p = log.p)
+ },
+ param = new("ParetoParameter"),
+ img = new("Reals"),
+ .logExact = TRUE,
+ .lowerExact = TRUE),
+ contains = "AbscontDistribution"
+ )
+
Modified: branches/distr-2.1/pkg/distrEx/R/AllInitialize.R
===================================================================
--- branches/distr-2.1/pkg/distrEx/R/AllInitialize.R 2009-03-17 19:19:49 UTC (rev 412)
+++ branches/distr-2.1/pkg/distrEx/R/AllInitialize.R 2009-03-18 21:18:17 UTC (rev 413)
@@ -4,22 +4,21 @@
.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){ rgumbel(n, loc = loc1, scale = scale1) }
+ .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, ...){ dgumbel(x, loc = loc1, scale = scale1, ...) }
- body(.Object at d) <- substitute({ dgumbel(x, loc = loc1, scale = scale1, ...) },
+ .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, ...){ pgumbel(q, loc = loc1, scale = scale1, ...) }
- body(.Object at p) <- substitute({ pgumbel(q, loc = loc1, scale = scale1, ...) },
+ .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, ...){}
+ .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
- mc <- as.list(match.call(call = sys.call())[-1])
- lower.tail <- mc$lower.tail
- if(is.null(lower.tail)) lower.tail <- TRUE
-
+ p <- if(log.p) exp(p) else p
+
in01 <- (p>1 | p<0)
i01 <- .isEqual01(p)
i0 <- (i01 & p<1)
@@ -29,7 +28,8 @@
p0 <- p
p0[ii01] <- 0.5
- q1 <- qgumbel(p0, loc = loc1, scale = scale1, ...)
+ 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
@@ -38,5 +38,41 @@
}, list(loc1 = loc, scale1 = scale))
.Object at .withSim <- FALSE
.Object at .withArith <- FALSE
+ .Object at .logExact <- FALSE
+ .Object at .lowerExact <- TRUE
.Object
})
+
+## Class: Pareto distribution
+setMethod("initialize", "Pareto",
+ function(.Object, shape = 1, Min = 1, .withArith = FALSE) {
+ .Object at img <- new("Reals")
+ .Object at param <- new("ParetoParameter", shape = shape, Min = Min)
+ .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(
+ { rpareto1(n, shape = shapeSub, min = MinSub) },
+ list(shapeSub = shape, MinSub = Min)
+ )
+ body(.Object at d) <- substitute(
+ { dpareto1(x, shape = shapeSub, min = MinSub,
+ log = log) },
+ list(shapeSub = shape, MinSub = Min)
+ )
+ body(.Object at p) <- substitute(
+ { ppareto1(q, shape = shapeSub, min = MinSub,
+ lower.tail = lower.tail, log.p = log.p) },
+ list(shapeSub = shape, MinSub = Min)
+ )
+ body(.Object at q) <- substitute(
+ { qpareto1(p, shape = shapeSub, min = MinSub,
+ lower.tail = lower.tail, log.p = log.p) },
+ list(shapeSub = shape, MinSub = Min)
+ )
+ .Object at .withArith <- .withArith
+ .Object at .logExact <- TRUE
+ .Object at .lowerExact <- TRUE
+ .Object
+ })
Modified: branches/distr-2.1/pkg/distrEx/R/AsymTotalVarDist.R
===================================================================
--- branches/distr-2.1/pkg/distrEx/R/AsymTotalVarDist.R 2009-03-17 19:19:49 UTC (rev 412)
+++ branches/distr-2.1/pkg/distrEx/R/AsymTotalVarDist.R 2009-03-18 21:18:17 UTC (rev 413)
@@ -55,8 +55,10 @@
## goal: range of density quotient d2(x)/d1(x)
## x-range:
x.range <- seq(low, up, length=Ngrid/3)
- x.range <- c(x.range, q(e1)(seq(TruncQuantile,1-TruncQuantile,length=Ngrid/3)))
- x.range <- c(x.range, q(e2)(seq(TruncQuantile,1-TruncQuantile,length=Ngrid/3)))
+ x.range <- c(x.range, q(e1)(seq(TruncQuantile,
+ 1-TruncQuantile,length=Ngrid/3)))
+ x.range <- c(x.range, q(e2)(seq(TruncQuantile,
+ 1-TruncQuantile,length=Ngrid/3)))
## to avoid division by 0:
d1x.range <- d10x.range <- d1(x.range)
d1x.range <- d1x.range+(d1x.range<1e-20)
Modified: branches/distr-2.1/pkg/distrEx/R/Expectation.R
===================================================================
--- branches/distr-2.1/pkg/distrEx/R/Expectation.R 2009-03-17 19:19:49 UTC (rev 412)
+++ branches/distr-2.1/pkg/distrEx/R/Expectation.R 2009-03-18 21:18:17 UTC (rev 413)
@@ -439,3 +439,11 @@
function(object){
return(0)
})
+
+setMethod("E", signature(object = "Pareto",
+ fun = "missing",
+ cond = "missing"),
+ function(object){a <- shape(object); b <- Min(object)
+ if(a<=1) return(Inf)
+ else return(b*a/(a-1))
+ })
Modified: branches/distr-2.1/pkg/distrEx/R/Functionals.R
===================================================================
--- branches/distr-2.1/pkg/distrEx/R/Functionals.R 2009-03-17 19:19:49 UTC (rev 412)
+++ branches/distr-2.1/pkg/distrEx/R/Functionals.R 2009-03-18 21:18:17 UTC (rev 413)
@@ -344,6 +344,15 @@
setMethod("var", signature(x = "Arcsine"),
function(x, ...)return(1/2))
+setMethod("var", signature(x = "Pareto"),
+ function(x, ...){
+ fun <- NULL; cond <- NULL
+ if((hasArg(fun))||(hasArg(cond)))
+ return(var(as(x,"AbscontDistribution"),...))
+ else{ a <- shape(x); b <- Min(x)
+ if(a<=2) return(NA)
+ return(b^2 * a/(a-1)^2/(a-2))
+ }})
#################################################################
# some exact medians
#################################################################
@@ -378,6 +387,11 @@
setMethod("median", signature(x = "Arcsine"),
function(x) 0)
+setMethod("median", signature(x = "Pareto"),
+ function(x) {a <- shape(x); b<- Min(x)
+ return(b*2^(1/a))
+ })
+
#################################################################
# some exact IQRs
#################################################################
@@ -410,6 +424,10 @@
setMethod("IQR", signature(x = "Arcsine"),
function(x) sqrt(2))
+setMethod("IQR", signature(x = "Pareto"),
+ function(x) {a <- shape(x); b<- Min(x)
+ return(b*(4^(1/a)-(4/3)^(1/a)))
+ })
#################################################################
# some exact mads
#################################################################
@@ -443,3 +461,8 @@
setMethod("mad", signature(x = "Arcsine"),
function(x) sqrt(1/2))
+
+setMethod("mad", signature(x = "Pareto"),
+ function(x) {a <- shape(x); b<- Min(x)
+ return(b*(sqrt(2)-1)*2^(1/a))
+ })
Modified: branches/distr-2.1/pkg/distrEx/R/Kurtosis.R
===================================================================
--- branches/distr-2.1/pkg/distrEx/R/Kurtosis.R 2009-03-17 19:19:49 UTC (rev 412)
+++ branches/distr-2.1/pkg/distrEx/R/Kurtosis.R 2009-03-18 21:18:17 UTC (rev 413)
@@ -291,7 +291,24 @@
###################################################################################
setMethod("kurtosis", signature(x = "Arcsine"),
- function(x, ...)return(-3/2))
+ function(x, ...){
+ fun <- NULL; cond <- NULL
+ if((hasArg(fun))||(hasArg(cond)))
+ return(kurtosis(as(x,"AbscontDistribution"),...))
+ else return(-3/2)
+ })
+setMethod("kurtosis", signature(x = "Pareto"),
+ function(x, ...){
+ fun <- NULL; cond <- NULL
+ if((hasArg(fun))||(hasArg(cond)))
+ return(kurtosis(as(x,"AbscontDistribution"),...))
+ else{
+ a <- shape(x)
+ if(a<=4) return(NA)
+ else
+ return( 6*(a^3+a^2-6*a-2)/a/(a-3)/(a-4) )
+ }
+})
Modified: branches/distr-2.1/pkg/distrEx/R/Skewness.R
===================================================================
--- branches/distr-2.1/pkg/distrEx/R/Skewness.R 2009-03-17 19:19:49 UTC (rev 412)
+++ branches/distr-2.1/pkg/distrEx/R/Skewness.R 2009-03-18 21:18:17 UTC (rev 413)
@@ -263,8 +263,26 @@
###################################################################################
setMethod("skewness", signature(x = "Arcsine"),
- function(x, ...)return(0))
+ function(x, ...){
+ fun <- NULL; cond <- NULL
+ if((hasArg(fun))||(hasArg(cond)))
+ return(skewness(as(x,"AbscontDistribution"),...))
+ else return(0)
+ })
+#
+setMethod("skewness", signature(x = "Pareto"),
+ function(x, ...){
+ fun <- NULL; cond <- NULL
+ if((hasArg(fun))||(hasArg(cond)))
+ return(skewness(as(x,"AbscontDistribution"),...))
+ else{
+ a <- shape(x)
+ if(a<=3) return(NA)
+ else
+ return( 2*(a+1)/(a-3)*sqrt(1-2/a) )
+ }
+})
Modified: branches/distr-2.1/pkg/distrEx/chm/00Index.html
===================================================================
--- branches/distr-2.1/pkg/distrEx/chm/00Index.html 2009-03-17 19:19:49 UTC (rev 412)
+++ branches/distr-2.1/pkg/distrEx/chm/00Index.html 2009-03-18 21:18:17 UTC (rev 413)
@@ -248,6 +248,8 @@
<td>Generic Function for the Computation of (Conditional) Expectations</td></tr>
<tr><td width="25%"><a href="E.html">E,Norm,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,Pareto,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,Pois,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,Td,missing,missing-method</a></td>
@@ -345,6 +347,8 @@
<table width="100%">
<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>
+<td>Pareto distribution</td></tr>
<tr><td width="25%"><a href="Var.html">IQR</a></td>
<td>Generic Functions for the Computation of Functionals</td></tr>
<tr><td width="25%"><a href="Var.html">IQR,AffLinAbscontDistribution-method</a></td>
@@ -375,6 +379,8 @@
<td>Generic Functions for the Computation of Functionals</td></tr>
<tr><td width="25%"><a href="Var.html">IQR,Norm-method</a></td>
<td>Generic Functions for the Computation of Functionals</td></tr>
+<tr><td width="25%"><a href="Var.html">IQR,Pareto-method</a></td>
+<td>Generic Functions for the Computation of Functionals</td></tr>
<tr><td width="25%"><a href="Var.html">IQR,Unif-method</a></td>
<td>Generic Functions for the Computation of Functionals</td></tr>
<tr><td width="25%"><a href="Var.html">IQR,UnivariateDistribution-method</a></td>
@@ -454,6 +460,8 @@
<td>Generic Functions for the Computation of Functionals</td></tr>
<tr><td width="25%"><a href="Var.html">kurtosis,Norm-method</a></td>
<td>Generic Functions for the Computation of Functionals</td></tr>
+<tr><td width="25%"><a href="Var.html">kurtosis,Pareto-method</a></td>
+<td>Generic Functions for the Computation of Functionals</td></tr>
<tr><td width="25%"><a href="Var.html">kurtosis,Pois-method</a></td>
<td>Generic Functions for the Computation of Functionals</td></tr>
<tr><td width="25%"><a href="Var.html">kurtosis,Td-method</a></td>
@@ -580,6 +588,8 @@
<td>Generic Functions for the Computation of Functionals</td></tr>
<tr><td width="25%"><a href="Var.html">mad,Norm-method</a></td>
<td>Generic Functions for the Computation of Functionals</td></tr>
+<tr><td width="25%"><a href="Var.html">mad,Pareto-method</a></td>
+<td>Generic Functions for the Computation of Functionals</td></tr>
<tr><td width="25%"><a href="Var.html">mad,Unif-method</a></td>
<td>Generic Functions for the Computation of Functionals</td></tr>
<tr><td width="25%"><a href="Var.html">mad,UnivariateDistribution-method</a></td>
@@ -622,12 +632,22 @@
<td>Generic Functions for the Computation of Functionals</td></tr>
<tr><td width="25%"><a href="Var.html">median,Norm-method</a></td>
<td>Generic Functions for the Computation of Functionals</td></tr>
+<tr><td width="25%"><a href="Var.html">median,Pareto-method</a></td>
+<td>Generic Functions for the Computation of Functionals</td></tr>
<tr><td width="25%"><a href="Var.html">median,Unif-method</a></td>
<td>Generic Functions for the Computation of Functionals</td></tr>
<tr><td width="25%"><a href="Var.html">median,UnivariateDistribution-method</a></td>
<td>Generic Functions for the Computation of Functionals</td></tr>
<tr><td width="25%"><a href="Var.html">median-methods</a></td>
<td>Generic Functions for the Computation of Functionals</td></tr>
+<tr><td width="25%"><a href="Pareto-class.html">Min,Pareto-method</a></td>
+<td>Pareto distribution</td></tr>
+<tr><td width="25%"><a href="ParetoParameter-class.html">Min,ParetoParameter-method</a></td>
+<td>Paramter of Pareto distributions</td></tr>
+<tr><td width="25%"><a href="Pareto-class.html">Min<-,Pareto-method</a></td>
+<td>Pareto distribution</td></tr>
+<tr><td width="25%"><a href="ParetoParameter-class.html">Min<-,ParetoParameter-method</a></td>
+<td>Paramter of Pareto distributions</td></tr>
<tr><td width="25%"><a href="MultivariateDistribution-class.html">MultivariateDistribution-class</a></td>
<td>Multivariate Distributions</td></tr>
</table>
@@ -679,6 +699,12 @@
<h2><a name="P">-- P --</a></h2>
<table width="100%">
+<tr><td width="25%"><a href="Pareto.html">Pareto</a></td>
+<td>Generating function for Pareto-class</td></tr>
+<tr><td width="25%"><a href="Pareto-class.html">Pareto-class</a></td>
+<td>Pareto distribution</td></tr>
+<tr><td width="25%"><a href="ParetoParameter-class.html">ParetoParameter-class</a></td>
+<td>Paramter of Pareto distributions</td></tr>
<tr><td width="25%"><a href="plot-methods.html">plot</a></td>
<td>Methods for Function plot in Package 'distrEx'</td></tr>
<tr><td width="25%"><a href="plot-methods.html">plot,MultivariateDistribution,missing-method</a></td>
@@ -729,6 +755,18 @@
<td>Generic Functions for the Computation of Functionals</td></tr>
<tr><td width="25%"><a href="Var.html">sd-methods</a></td>
<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="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="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="EuclCondition-class.html">show,EuclCondition-method</a></td>
<td>Conditioning by an Euclidean space.</td></tr>
<tr><td width="25%"><a href="LMParameter-class.html">show,LMParameter-method</a></td>
@@ -783,6 +821,8 @@
<td>Generic Functions for the Computation of Functionals</td></tr>
<tr><td width="25%"><a href="Var.html">skewness,Norm-method</a></td>
<td>Generic Functions for the Computation of Functionals</td></tr>
+<tr><td width="25%"><a href="Var.html">skewness,Pareto-method</a></td>
+<td>Generic Functions for the Computation of Functionals</td></tr>
<tr><td width="25%"><a href="Var.html">skewness,Pois-method</a></td>
<td>Generic Functions for the Computation of Functionals</td></tr>
<tr><td width="25%"><a href="Var.html">skewness,Td-method</a></td>
@@ -888,6 +928,8 @@
<td>Generic Functions for the Computation of Functionals</td></tr>
<tr><td width="25%"><a href="Var.html">var,Norm-method</a></td>
<td>Generic Functions for the Computation of Functionals</td></tr>
+<tr><td width="25%"><a href="Var.html">var,Pareto-method</a></td>
+<td>Generic Functions for the Computation of Functionals</td></tr>
<tr><td width="25%"><a href="Var.html">var,Pois-method</a></td>
<td>Generic Functions for the Computation of Functionals</td></tr>
<tr><td width="25%"><a href="Var.html">var,Td-method</a></td>
Modified: branches/distr-2.1/pkg/distrEx/chm/0distrEx-package.html
===================================================================
--- branches/distr-2.1/pkg/distrEx/chm/0distrEx-package.html 2009-03-17 19:19:49 UTC (rev 412)
+++ branches/distr-2.1/pkg/distrEx/chm/0distrEx-package.html 2009-03-18 21:18:17 UTC (rev 413)
@@ -73,6 +73,7 @@
|>"UnivariateDistribution" (from distr)
|>|>"AbscontDistribution" (from distr)
|>|>|>"Gumbel"
+|>|>|>"Pareto"
|>"MultivariateDistribution"
|>|>"DiscreteMVDistribution-class"
|>"UnivariateCondDistribution"
@@ -93,6 +94,7 @@
|>"Parameter" (from distr)
|>|>"LMParameter"
|>|>"GumbelParameter"
+|>|>"ParetoParameter"
</pre>
</p>
@@ -156,6 +158,11 @@
Kolmogorov distance of two distributions
TotalVarDist Generic function for the computation of the
total variation distance of two distributions
+AsymTotalVarDist Generic function for the computation of the
+ asymmetric total variation distance of two distributions
+ (for given ratio rho of negative to positive part of deviation)
+OAsymTotalVarDist Generic function for the computation of the minimal (in rho)
+ asymmetric total variation distance of two distributions
vonMisesDist Generic function for the computation of the
von Mises distance of two distributions
@@ -204,6 +211,8 @@
<p>
G. Jay Kerns, <a href="mailto:gkerns at ysu.edu">gkerns at ysu.edu</a>, has provided a major contribution,
in particular the functionals <code>skewness</code> and <code>kurtosis</code> are due to him.
+Natalyia Horbenko, <a href="mailto:natalyia.horbenko at itwm.fraunhofer.de">natalyia.horbenko at itwm.fraunhofer.de</a> has ported
+the <span class="pkg">actuar</span> code for the Pareto distribution to this setup.
</p>
Modified: branches/distr-2.1/pkg/distrEx/chm/E.html
===================================================================
--- branches/distr-2.1/pkg/distrEx/chm/E.html 2009-03-17 19:19:49 UTC (rev 412)
+++ branches/distr-2.1/pkg/distrEx/chm/E.html 2009-03-18 21:18:17 UTC (rev 413)
@@ -56,6 +56,7 @@
<param name="keyword" value="R: E,Unif,missing,missing-method">
<param name="keyword" value="R: E,Weibull,missing,missing-method">
<param name="keyword" value="R: E,Arcsine,missing,missing-method">
+<param name="keyword" value="R: E,Pareto,missing,missing-method">
<param name="keyword" value=" Generic Function for the Computation of (Conditional) Expectations">
</object>
@@ -173,6 +174,8 @@
E(object)
## S4 method for signature 'Arcsine, missing, missing':
E(object)
+## S4 method for signature 'Pareto, missing, missing':
+E(object)
</pre>
@@ -344,6 +347,7 @@
<dt>object = "Td", fun = "missing", cond = "missing":</dt><dd>exact evaluation using explicit expressions.</dd>
<dt>object = "Weibull", fun = "missing", cond = "missing":</dt><dd>exact evaluation using explicit expressions.</dd>
<dt>object = "Arcsine", fun = "missing", cond = "missing":</dt><dd>exact evaluation using explicit expressions.</dd>
+<dt>object = "Pareto", fun = "missing", cond = "missing":</dt><dd>exact evaluation using explicit expressions.</dd>
</dl>
<h3>Author(s)</h3>
@@ -410,6 +414,6 @@
</script>
-<hr><div align="center">[Package <em>distrEx</em> version 2.1 <a href="00Index.html">Index]</a></div>
+<hr><div align="center">[Package <em>distrEx</em> version 2.1 <a href="00Index.html">Index</a>]</div>
</body></html>
Modified: branches/distr-2.1/pkg/distrEx/chm/Var.html
===================================================================
--- branches/distr-2.1/pkg/distrEx/chm/Var.html 2009-03-17 19:19:49 UTC (rev 412)
+++ branches/distr-2.1/pkg/distrEx/chm/Var.html 2009-03-18 21:18:17 UTC (rev 413)
@@ -34,6 +34,7 @@
<param name="keyword" value="R: var,Weibull-method">
<param name="keyword" value="R: var,Td-method">
<param name="keyword" value="R: var,Arcsine-method">
+<param name="keyword" value="R: var,Pareto-method">
<param name="keyword" value="R: sd">
<param name="keyword" value="R: sd-methods">
<param name="keyword" value="R: sd,UnivariateDistribution-method">
@@ -56,6 +57,7 @@
<param name="keyword" value="R: median,Norm-method">
<param name="keyword" value="R: median,Unif-method">
<param name="keyword" value="R: median,Arcsine-method">
+<param name="keyword" value="R: median,Pareto-method">
<param name="keyword" value="R: IQR">
<param name="keyword" value="R: IQR-methods">
<param name="keyword" value="R: IQR,ANY-method">
@@ -74,6 +76,7 @@
<param name="keyword" value="R: IQR,Norm-method">
<param name="keyword" value="R: IQR,Unif-method">
<param name="keyword" value="R: IQR,Arcsine-method">
+<param name="keyword" value="R: IQR,Pareto-method">
<param name="keyword" value="R: mad">
<param name="keyword" value="R: mad,ANY-method">
<param name="keyword" value="R: mad-methods">
@@ -91,6 +94,7 @@
<param name="keyword" value="R: mad,Norm-method">
<param name="keyword" value="R: mad,Unif-method">
<param name="keyword" value="R: mad,Arcsine-method">
+<param name="keyword" value="R: mad,Pareto-method">
<param name="keyword" value="R: skewness">
<param name="keyword" value="R: skewness-methods">
<param name="keyword" value="R: skewness,ANY-method">
@@ -119,6 +123,7 @@
<param name="keyword" value="R: skewness,Weibull-method">
<param name="keyword" value="R: skewness,Td-method">
<param name="keyword" value="R: skewness,Arcsine-method">
+<param name="keyword" value="R: skewness,Pareto-method">
<param name="keyword" value="R: kurtosis">
<param name="keyword" value="R: kurtosis-methods">
<param name="keyword" value="R: kurtosis,ANY-method">
@@ -147,6 +152,7 @@
<param name="keyword" value="R: kurtosis,Weibull-method">
<param name="keyword" value="R: kurtosis,Td-method">
<param name="keyword" value="R: kurtosis,Arcsine-method">
+<param name="keyword" value="R: kurtosis,Pareto-method">
<param name="keyword" value=" Generic Functions for the Computation of Functionals">
</object>
@@ -190,6 +196,8 @@
IQR(x)
## S4 method for signature 'Arcsine':
IQR(x)
+## S4 method for signature 'Pareto':
+IQR(x)
median(x, ...)
@@ -217,6 +225,8 @@
median(x)
## S4 method for signature 'Arcsine':
median(x)
+## S4 method for signature 'Pareto':
+median(x)
mad(x, ...)
@@ -242,6 +252,8 @@
mad(x)
## S4 method for signature 'Arcsine':
mad(x)
+## S4 method for signature 'Pareto':
+mad(x)
sd(x, ...)
@@ -298,6 +310,8 @@
var(x, ...)
## S4 method for signature 'Arcsine':
var(x, ...)
+## S4 method for signature 'Pareto':
+var(x, ...)
skewness(x, ...)
## S4 method for signature 'UnivariateDistribution':
@@ -344,6 +358,8 @@
skewness(x, ...)
## S4 method for signature 'Arcsine':
skewness(x, ...)
+## S4 method for signature 'Pareto':
+skewness(x, ...)
kurtosis(x, ...)
## S4 method for signature 'UnivariateDistribution':
@@ -390,6 +406,8 @@
kurtosis(x, ...)
## S4 method for signature 'Arcsine':
kurtosis(x, ...)
+## S4 method for signature 'Pareto':
+kurtosis(x, ...)
</pre>
@@ -504,6 +522,7 @@
<dt><code>var</code>, <code>signature(x = "Unif")</code>:</dt><dd>exact evaluation using explicit expressions.</dd>
<dt><code>var</code>, <code>signature(x = "Weibull")</code>:</dt><dd>exact evaluation using explicit expressions.</dd>
<dt><code>var</code>, <code>signature(x = "Arcsine")</code>:</dt><dd>exact evaluation using explicit expressions.</dd>
+<dt><code>var</code>, <code>signature(x = "Pareto")</code>:</dt><dd>exact evaluation using explicit expressions.</dd>
<dt><code>IQR</code>, <code>signature(x = "Cauchy")</code>:</dt><dd>exact evaluation using explicit expressions.</dd>
@@ -515,6 +534,7 @@
<dt><code>IQR</code>, <code>signature(x = "Norm")</code>:</dt><dd>exact evaluation using explicit expressions.</dd>
<dt><code>IQR</code>, <code>signature(x = "Unif")</code>:</dt><dd>exact evaluation using explicit expressions.</dd>
<dt><code>IQR</code>, <code>signature(x = "Arcsine")</code>:</dt><dd>exact evaluation using explicit expressions.</dd>
+<dt><code>IQR</code>, <code>signature(x = "Pareto")</code>:</dt><dd>exact evaluation using explicit expressions.</dd>
[TRUNCATED]
To get the complete diff run:
svnlook diff /svnroot/distr -r 413
More information about the Distr-commits
mailing list