[Distr-commits] r1181 - in pkg/distrEx: . R demo inst man src
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Sun Jul 8 16:24:07 CEST 2018
Author: ruckdeschel
Date: 2018-07-08 16:24:06 +0200 (Sun, 08 Jul 2018)
New Revision: 1181
Added:
pkg/distrEx/R/EmpiricalMVDistribution.R
pkg/distrEx/man/EmpiricalMVDistribution.Rd
Removed:
pkg/distrEx/R/EmpiricalMVDistribution.R
pkg/distrEx/man/EmpiricalMVDistribution.Rd
Modified:
pkg/distrEx/DESCRIPTION
pkg/distrEx/R/AsymTotalVarDist.R
pkg/distrEx/R/ClippedMoments.R
pkg/distrEx/R/ContaminationSize.R
pkg/distrEx/R/ConvexContamination.R
pkg/distrEx/R/Expectation.R
pkg/distrEx/R/Functionals.R
pkg/distrEx/R/HellingerDist.R
pkg/distrEx/R/KolmogorovDist.R
pkg/distrEx/R/Kurtosis.R
pkg/distrEx/R/LMCondDistribution.R
pkg/distrEx/R/OAsymTotalVarDist.R
pkg/distrEx/R/PrognCondDistribution.R
pkg/distrEx/R/Skewness.R
pkg/distrEx/R/TotalVarDist.R
pkg/distrEx/R/distrExIntegrate.R
pkg/distrEx/R/distrExOptions.R
pkg/distrEx/R/sysdata.rda
pkg/distrEx/demo/Prognose.R
pkg/distrEx/inst/NEWS
pkg/distrEx/man/0distrEx-package.Rd
pkg/distrEx/man/AsymTotalVarDist.Rd
pkg/distrEx/man/DiscreteMVDistribution-class.Rd
pkg/distrEx/man/HellingerDist.Rd
pkg/distrEx/man/LMCondDistribution.Rd
pkg/distrEx/man/OAsymTotalVarDist.Rd
pkg/distrEx/man/TotalVarDist.Rd
pkg/distrEx/man/internals.Rd
pkg/distrEx/src/GLaw.c
Log:
[distrEx] merged branch 2.7 back to trunk
Modified: pkg/distrEx/DESCRIPTION
===================================================================
--- pkg/distrEx/DESCRIPTION 2018-07-08 14:23:40 UTC (rev 1180)
+++ pkg/distrEx/DESCRIPTION 2018-07-08 14:24:06 UTC (rev 1181)
@@ -1,17 +1,18 @@
Package: distrEx
-Version: 2.6.1
-Date: 2017-04-23
+Version: 2.7
+Date: 2015-11-07
Title: Extensions of Package 'distr'
Description: Extends package 'distr' by functionals, distances, and conditional distributions.
Depends: R(>= 2.10.0), methods, distr(>= 2.2)
Imports: startupmsg, utils, stats
Suggests: tcltk
-Authors at R: c(person("Matthias", "Kohl", role=c("cre", "cph", "aut"), email="Matthias.Kohl at stamats.de"), person("Peter", "Ruckdeschel",
- role=c("aut", "cph")))
+Authors at R: c(person("Matthias", "Kohl", role=c("cre", "cph"),
+ email="Matthias.Kohl at stamats.de"), person("Peter", "Ruckdeschel", role=c("aut",
+ "cph")))
ByteCompile: yes
License: LGPL-3
Encoding: latin1
URL: http://distr.r-forge.r-project.org/
LastChangedDate: {$LastChangedDate$}
LastChangedRevision: {$LastChangedRevision$}
-SVNRevision: 1132
+SVNRevision: 1080
Modified: pkg/distrEx/R/AsymTotalVarDist.R
===================================================================
--- pkg/distrEx/R/AsymTotalVarDist.R 2018-07-08 14:23:40 UTC (rev 1180)
+++ pkg/distrEx/R/AsymTotalVarDist.R 2018-07-08 14:24:06 UTC (rev 1181)
@@ -55,9 +55,9 @@
## 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,
+ x.range <- c(x.range, q.l(e1)(seq(TruncQuantile,
1-TruncQuantile,length=Ngrid/3)))
- x.range <- c(x.range, q(e2)(seq(TruncQuantile,
+ x.range <- c(x.range, q.l(e2)(seq(TruncQuantile,
1-TruncQuantile,length=Ngrid/3)))
## to avoid division by 0:
d1x.range <- d10x.range <- d1(x.range)
@@ -290,8 +290,8 @@
### continuous part
## x-range:
x.range <- seq(low, up, length=Ngrid/3)
- x.range <- c(x.range, q(ac1)(seq(TruncQuantile,1-TruncQuantile,length=Ngrid/3)))
- x.range <- c(x.range, q(ac2)(seq(TruncQuantile,1-TruncQuantile,length=Ngrid/3)))
+ x.range <- c(x.range, q.l(ac1)(seq(TruncQuantile,1-TruncQuantile,length=Ngrid/3)))
+ x.range <- c(x.range, q.l(ac2)(seq(TruncQuantile,1-TruncQuantile,length=Ngrid/3)))
## to avoid division by 0:
d1x.range <- d10x.range <- ac1.d(x.range)
d1x.range <- d1x.range+(d1x.range<1e-20)
Modified: pkg/distrEx/R/ClippedMoments.R
===================================================================
--- pkg/distrEx/R/ClippedMoments.R 2018-07-08 14:23:40 UTC (rev 1180)
+++ pkg/distrEx/R/ClippedMoments.R 2018-07-08 14:24:06 UTC (rev 1181)
@@ -66,14 +66,14 @@
#setMethod("m1df", "AbscontDistribution",
# function(object, upper, ...){
# integrandm1 <- function(x, dfun){ x * dfun(x) }
-# return(distrExIntegrate(integrandm1, lower = q(object)(.distrExOptions$m1dfLowerTruncQuantile),
+# return(distrExIntegrate(integrandm1, lower = q.l(object)(.distrExOptions$m1dfLowerTruncQuantile),
# rel.tol = .distrExOptions$m1dfRelativeTolerance, upper = upper, dfun = d(object),
# distr = object))
# })
#setMethod("m2df", "AbscontDistribution",
# function(object, upper, ...){
# integrandm2 <- function(x, dfun){ x^2 * dfun(x) }
-# return(distrExIntegrate(integrandm2, lower = q(object)(.distrExOptions$m2dfLowerTruncQuantile),
+# return(distrExIntegrate(integrandm2, lower = q.l(object)(.distrExOptions$m2dfLowerTruncQuantile),
# rel.tol = .distrExOptions$m2dfRelativeTolerance, upper = upper, dfun = d(object),
# distr = object))
# })
Modified: pkg/distrEx/R/ContaminationSize.R
===================================================================
--- pkg/distrEx/R/ContaminationSize.R 2018-07-08 14:23:40 UTC (rev 1180)
+++ pkg/distrEx/R/ContaminationSize.R 2018-07-08 14:24:06 UTC (rev 1181)
@@ -6,8 +6,8 @@
e2 = "AbscontDistribution"),
function(e1, e2){
ep <- getdistrOption("TruncQuantile")
- lower <- min(q(e1)(ep), q(e2)(ep))
- upper <- max(q(e1)(1-ep), q(e2)(1-ep))
+ lower <- min(q.l(e1)(ep), q.l(e2)(ep))
+ upper <- max(q.l(e1)(1-ep), q.l(e2)(1-ep))
x <- seq(from = lower, to = upper, length = 1e5)
d10 <- d(e1)(x); d1 <- d10[ d10>0 ]
Modified: pkg/distrEx/R/ConvexContamination.R
===================================================================
--- pkg/distrEx/R/ConvexContamination.R 2018-07-08 14:23:40 UTC (rev 1180)
+++ pkg/distrEx/R/ConvexContamination.R 2018-07-08 14:24:06 UTC (rev 1181)
@@ -48,13 +48,13 @@
},
list(size = size, p1fun = p(e1), p2fun = p(e2)))
- m1 <- min(q(e1)(TruncQuantile), q(e2)(TruncQuantile))
+ m1 <- min(q.l(e1)(TruncQuantile), q.l(e2)(TruncQuantile))
m21 <- ifelse("lower.tail" %in% names(formals(e1 at q)),
- q(e1)(TruncQuantile, lower.tail = FALSE),
- q(e1)(1-TruncQuantile))
+ q.l(e1)(TruncQuantile, lower.tail = FALSE),
+ q.l(e1)(1-TruncQuantile))
m22 <- ifelse("lower.tail" %in% names(formals(e2 at q)),
- q(e2)(TruncQuantile, lower.tail = FALSE),
- q(e2)(1-TruncQuantile))
+ q.l(e2)(TruncQuantile, lower.tail = FALSE),
+ q.l(e2)(1-TruncQuantile))
m2 <- max(m21,m22); rm(m21,m22)
qfun <- function(p, lower.tail = TRUE, log.p = FALSE){}
@@ -204,13 +204,13 @@
list(size = size, p1fun = p(e1), p2fun = p(e2)))
TruncQuantile <- getdistrOption("TruncQuantile")
- m1 <- min(q(e1)(TruncQuantile), q(e2)(TruncQuantile))
+ m1 <- min(q.l(e1)(TruncQuantile), q.l(e2)(TruncQuantile))
m21 <- ifelse("lower.tail" %in% names(formals(e1 at q)),
- q(e1)(TruncQuantile, lower.tail = FALSE),
- q(e1)(1-TruncQuantile))
+ q.l(e1)(TruncQuantile, lower.tail = FALSE),
+ q.l(e1)(1-TruncQuantile))
m22 <- ifelse("lower.tail" %in% names(formals(e2 at q)),
- q(e2)(TruncQuantile, lower.tail = FALSE),
- q(e2)(1-TruncQuantile))
+ q.l(e2)(TruncQuantile, lower.tail = FALSE),
+ q.l(e2)(1-TruncQuantile))
m2 <- max(m21,m22); rm(m21,m22)
Deleted: pkg/distrEx/R/EmpiricalMVDistribution.R
===================================================================
--- pkg/distrEx/R/EmpiricalMVDistribution.R 2018-07-08 14:23:40 UTC (rev 1180)
+++ pkg/distrEx/R/EmpiricalMVDistribution.R 2018-07-08 14:24:06 UTC (rev 1181)
@@ -1,7 +0,0 @@
-###############################################################################
-## Generating function to generate empirical distribution given some data
-###############################################################################
-
-EmpiricalMVDistribution <- function(data, Symmetry = NoSymmetry()){
- DiscreteMVDistribution(supp = data, Symmetry = Symmetry)
-}
Copied: pkg/distrEx/R/EmpiricalMVDistribution.R (from rev 1173, pkg/distrEx/R/EmpiricalMVDistribution.R)
===================================================================
--- pkg/distrEx/R/EmpiricalMVDistribution.R (rev 0)
+++ pkg/distrEx/R/EmpiricalMVDistribution.R 2018-07-08 14:24:06 UTC (rev 1181)
@@ -0,0 +1,7 @@
+###############################################################################
+## Generating function to generate empirical distribution given some data
+###############################################################################
+
+EmpiricalMVDistribution <- function(data, Symmetry = NoSymmetry()){
+ DiscreteMVDistribution(supp = data, Symmetry = Symmetry)
+}
Modified: pkg/distrEx/R/Expectation.R
===================================================================
--- pkg/distrEx/R/Expectation.R 2018-07-08 14:23:40 UTC (rev 1180)
+++ pkg/distrEx/R/Expectation.R 2018-07-08 14:24:06 UTC (rev 1181)
@@ -1,7 +1,7 @@
## Helper function:
.getIntbounds <- function(object, low, upp, lowTQ, uppTQ, IQR.fac, ...){
- qx <- q(object)
+ qx <- q.l(object)
low0 <- qx(lowTQ, lower.tail = TRUE, ...)
upp0 <- ifelse( "lower.tail" %in% names(formals(qx)),
qx(uppTQ, lower.tail = FALSE, ...),
@@ -440,7 +440,7 @@
else
return(shape1(object)/(shape1(object)+shape2(object)))
})
-## source: http://mathworld.wolfram.com/BetaDistribution.html
+## source: https://mathworld.wolfram.com/BetaDistribution.html
setMethod("E", signature(object = "Binom",
fun = "missing",
@@ -465,7 +465,7 @@
}
})
-### source: http://mathworld.wolfram.com/BinomialDistribution.html
+### source: https://mathworld.wolfram.com/BinomialDistribution.html
setMethod("E", signature(object = "Cauchy",
fun = "missing",
@@ -488,7 +488,7 @@
# return(E(as(object,"AbscontDistribution"), low=low, upp=upp, ...))
})
-### source http://mathworld.wolfram.com/CauchyDistribution.html
+### source https://mathworld.wolfram.com/CauchyDistribution.html
setMethod("E", signature(object = "Chisq",
fun = "missing",
@@ -511,7 +511,7 @@
}
}
})
-### source http://mathworld.wolfram.com/Chi-SquaredDistribution.html
+### source https://mathworld.wolfram.com/Chi-SquaredDistribution.html
setMethod("E", signature(object = "Dirac",
fun = "missing",
@@ -536,7 +536,7 @@
return(E(as(object,"AbscontDistribution"), low=low, upp=upp, ...))
})
-### source http://mathworld.wolfram.com/LaplaceDistribution.html
+### source https://mathworld.wolfram.com/LaplaceDistribution.html
setMethod("E", signature(object = "Exp",
fun = "missing",
@@ -560,7 +560,7 @@
}
})
- ### source http://mathworld.wolfram.com/ExponentialDistribution.html
+ ### source https://mathworld.wolfram.com/ExponentialDistribution.html
setMethod("E", signature(object = "Fd",
fun = "missing",
@@ -576,7 +576,7 @@
else
return(E(as(object,"AbscontDistribution"), low=low, upp=upp, ...))
})
-### source (without ncp) http://mathworld.wolfram.com/F-Distribution.html
+### source (without ncp) https://mathworld.wolfram.com/F-Distribution.html
setMethod("E", signature(object = "Gammad",
fun = "missing",
@@ -589,7 +589,7 @@
return(E(as(object,"AbscontDistribution"), low=low, upp=upp, ...))
})
-### source http://mathworld.wolfram.com/GammaDistribution.html
+### source https://mathworld.wolfram.com/GammaDistribution.html
setMethod("E", signature(object = "Gammad",
fun = "function",
@@ -644,7 +644,7 @@
return(E(as(object,"DiscreteDistribution"), low=low, upp=upp, ...))
})
-### source http://mathworld.wolfram.com/GeometricDistribution.html
+### source https://mathworld.wolfram.com/GeometricDistribution.html
setMethod("E", signature(object = "Hyper",
fun = "missing",
@@ -657,7 +657,7 @@
else
return(E(as(object,"DiscreteDistribution"), low=low, upp=upp, ...))
})
-### source http://mathworld.wolfram.com/HypergeometricDistribution.html
+### source https://mathworld.wolfram.com/HypergeometricDistribution.html
setMethod("E", signature(object = "Logis",
fun = "missing",
@@ -668,7 +668,7 @@
else
return(E(as(object,"AbscontDistribution"), low=low, upp=upp, ...))
})
-### source http://mathworld.wolfram.com/LogisticDistribution.html
+### source https://mathworld.wolfram.com/LogisticDistribution.html
setMethod("E", signature(object = "Lnorm",
fun = "missing",
@@ -680,7 +680,7 @@
else
return(E(as(object,"AbscontDistribution"), low=low, upp=upp, ...))
})
-### source http://mathworld.wolfram.com/LogNormalDistribution.html
+### source https://mathworld.wolfram.com/LogNormalDistribution.html
setMethod("E", signature(object = "Nbinom",
fun = "missing",
@@ -693,7 +693,7 @@
else
return(E(as(object,"DiscreteDistribution"), low=low, upp=upp, ...))
})
-### source http://mathworld.wolfram.com/NegativeBinomialDistribution.html
+### source https://mathworld.wolfram.com/NegativeBinomialDistribution.html
setMethod("E", signature(object = "Pois",
fun = "missing",
@@ -706,7 +706,7 @@
else
return(E(as(object,"DiscreteDistribution"), low=low, upp=upp, ...))
})
-### source http://mathworld.wolfram.com/PoissonDistribution.html
+### source https://mathworld.wolfram.com/PoissonDistribution.html
setMethod("E", signature(object = "Td",
fun = "missing",
@@ -721,7 +721,7 @@
else
return(E(as(object,"AbscontDistribution"), low=low, upp=upp, ...))
})
-### source http://mathworld.wolfram.com/NoncentralStudentst-Distribution.html
+### source https://mathworld.wolfram.com/NoncentralStudentst-Distribution.html
setMethod("E", signature(object = "Unif",
fun = "missing",
cond = "missing"),
@@ -733,7 +733,7 @@
else
return(E(as(object,"AbscontDistribution"), low=low, upp=upp, ...))
})
-### source http://mathworld.wolfram.com/UniformDistribution.html
+### source https://mathworld.wolfram.com/UniformDistribution.html
setMethod("E", signature(object = "Weibull",
fun = "missing",
@@ -745,7 +745,7 @@
else
return(E(as(object,"AbscontDistribution"), low=low, upp=upp, ...))
})
-### source http://mathworld.wolfram.com/WeibullDistribution.html
+### source https://mathworld.wolfram.com/WeibullDistribution.html
setMethod("E", signature(object = "Arcsine",
fun = "missing",
cond = "missing"),
@@ -861,8 +861,8 @@
function(object, low = NULL, upp = NULL, ...){
S <- object at SummandsDistr
N <- object at NumbOfSummandsDistr
- if(!is.null(low)) if(low <= q(object)(0)) low <- NULL
- if(!is.null(upp)) if(upp >= q(object)(1)) upp <- NULL
+ if(!is.null(low)) if(low <= q.l(object)(0)) low <- NULL
+ if(!is.null(upp)) if(upp >= q.l(object)(1)) upp <- NULL
if(is(S,"UnivariateDistribution") && is.null(low) && is.null(upp))
return(E(S, ...)*E(N))
Modified: pkg/distrEx/R/Functionals.R
===================================================================
--- pkg/distrEx/R/Functionals.R 2018-07-08 14:23:40 UTC (rev 1180)
+++ pkg/distrEx/R/Functionals.R 2018-07-08 14:24:06 UTC (rev 1181)
@@ -128,12 +128,12 @@
function(x){
if(is(Symmetry(x),"SphericalSymmetry"))
return(SymmCenter(Symmetry(x)))
- return(q(x)(1/2))
+ return(q.l(x)(1/2))
})
setMethod("median", signature(x = "UnivariateCondDistribution"),
function(x, cond){
- return(q(x)(1/2, cond = cond))
+ return(q.l(x)(1/2, cond = cond))
})
setMethod("median", signature(x = "AffLinDistribution"),
@@ -149,10 +149,10 @@
setMethod("mad", signature(x = "UnivariateDistribution"),
function(x){
if(is(Symmetry(x),"SphericalSymmetry"))
- return(q(x)(3/4))
+ return(q.l(x)(3/4))
m <- median(x)
y <- abs(x-m)
- return(q(y)(1/2))
+ return(q.l(y)(1/2))
})
setMethod("mad", signature(x = "AffLinDistribution"),
@@ -168,17 +168,17 @@
setMethod("IQR", signature(x = "UnivariateDistribution"),
function(x){
if(is(Symmetry(x),"SphericalSymmetry"))
- return(2*q(x)(3/4))
- return(q(x)(3/4)-q(x)(1/4))
+ return(2*q.l(x)(3/4))
+ return(q.l(x)(3/4)-q.l(x)(1/4))
})
setMethod("IQR", signature(x = "UnivariateCondDistribution"),
function(x, cond){
- return(q(x)(3/4, cond = cond)-q(x)(1/4, cond = cond))
+ return(q.l(x)(3/4, cond = cond)-q.l(x)(1/4, cond = cond))
})
setMethod("IQR", signature(x = "DiscreteDistribution"),
- function(x) q.r(x)(3/4)-q(x)(1/4)
+ function(x) q.r(x)(3/4)-q.l(x)(1/4)
)
setMethod("IQR", signature(x = "AffLinDistribution"),
@@ -227,7 +227,7 @@
else
return(size(x)*prob(x)*(1-prob(x)))
})
-### source: http://mathworld.wolfram.com/BinomialDistribution.html
+### source: https://mathworld.wolfram.com/BinomialDistribution.html
setMethod("var", signature(x = "Cauchy"),
@@ -242,7 +242,7 @@
else
return(NA)
})
-### source http://mathworld.wolfram.com/CauchyDistribution.html
+### source https://mathworld.wolfram.com/CauchyDistribution.html
setMethod("var", signature(x = "Chisq"),
function(x,...){
@@ -256,7 +256,7 @@
else
return(2*(df(x)+2*ncp(x)))
})
-### source http://mathworld.wolfram.com/Chi-SquaredDistribution.html
+### source https://mathworld.wolfram.com/Chi-SquaredDistribution.html
setMethod("var", signature(x = "Dirac"),
function(x, ...){return(0)})
@@ -274,7 +274,7 @@
else
return(2)
})
-### source http://mathworld.wolfram.com/LaplaceDistribution.html
+### source https://mathworld.wolfram.com/LaplaceDistribution.html
setMethod("var", signature(x = "Exp"),
function(x, ...){
@@ -289,7 +289,7 @@
return(1/rate(x)^2)
})
- ### source http://mathworld.wolfram.com/ExponentialDistribution.html
+ ### source https://mathworld.wolfram.com/ExponentialDistribution.html
setMethod("var", signature(x = "Fd"),
function(x, ...){
@@ -308,7 +308,7 @@
Exx <- df2^2/(df2-2)/(df2-4)*((df1+d)^2+2*df1+4*d)/df1^2
return(ifelse(df2>4,Exx-Ex2, NA ))}
})
-### source (without ncp) http://mathworld.wolfram.com/F-Distribution.html
+### source (without ncp) https://mathworld.wolfram.com/F-Distribution.html
setMethod("var", signature(x = "Gammad"),
function(x, ...){
@@ -322,7 +322,7 @@
else
return(shape(x)*scale(x)^2)
})
-### source http://mathworld.wolfram.com/GammaDistribution.html
+### source https://mathworld.wolfram.com/GammaDistribution.html
setMethod("var", signature(x = "Geom"),
function(x, ...){
@@ -335,7 +335,7 @@
return(var(as(x,"DiscreteDistribution"),...))
else {p <- prob(x); e <- 1/p-1; return(e+e^2)}
})
-### source http://mathworld.wolfram.com/GeometricDistribution.html
+### source https://mathworld.wolfram.com/GeometricDistribution.html
setMethod("var", signature(x = "Hyper"),
function(x, ...){
@@ -352,7 +352,7 @@
n <- n(x);
return(k*n/(m+n)*m/(m+n)*(m+n-k)/(m+n-1))}
})
-### source http://mathworld.wolfram.com/HypergeometricDistribution.html
+### source https://mathworld.wolfram.com/HypergeometricDistribution.html
setMethod("var", signature(x = "Logis"),
function(x, ...){
@@ -366,7 +366,7 @@
else
return(pi^2/3*scale(x)^2)
})
-### source http://mathworld.wolfram.com/LogisticDistribution.html
+### source https://mathworld.wolfram.com/LogisticDistribution.html
setMethod("var", signature(x = "Lnorm"),
function(x, ...){
@@ -380,7 +380,7 @@
else
return(exp(2*meanlog(x)+sdlog(x)^2)*(exp(sdlog(x)^2)-1))
})
-### source http://mathworld.wolfram.com/LogNormalDistribution.html
+### source https://mathworld.wolfram.com/LogNormalDistribution.html
setMethod("var", signature(x = "Nbinom"),
function(x, ...){
@@ -393,7 +393,7 @@
return(var(as(x,"DiscreteDistribution"),...))
else {p <- prob(x); e <- 1/p-1; return(size(x)*(e+e^2))}
})
-### source http://mathworld.wolfram.com/NegativeBinomialDistribution.html
+### source https://mathworld.wolfram.com/NegativeBinomialDistribution.html
setMethod("var", signature(x = "Pois"),
function(x, ...){
@@ -407,7 +407,7 @@
else
return(lambda(x))
})
-### source http://mathworld.wolfram.com/PoissonDistribution.html
+### source https://mathworld.wolfram.com/PoissonDistribution.html
setMethod("var", signature(x = "Td"),
function(x, ...){
@@ -426,7 +426,7 @@
}
})
-### source http://mathworld.wolfram.com/NoncentralStudentst-Distribution.html
+### source https://mathworld.wolfram.com/NoncentralStudentst-Distribution.html
setMethod("var", signature(x = "Unif"),
function(x, ...){
@@ -440,7 +440,7 @@
else
return((Max(x)-Min(x))^2/12)
})
-### source http://mathworld.wolfram.com/UniformDistribution.html
+### source https://mathworld.wolfram.com/UniformDistribution.html
setMethod("var", signature(x = "Weibull"),
function(x, ...){
@@ -454,7 +454,7 @@
else
return(scale(x)^2*(gamma(1+2/shape(x))- (gamma(1 + 1/shape(x)))^2))
})
-### source http://mathworld.wolfram.com/WeibullDistribution.html
+### source https://mathworld.wolfram.com/WeibullDistribution.html
setMethod("var", signature(x = "Beta"),
function(x, ...){
@@ -469,7 +469,7 @@
{a<-shape1(x); b<- shape2(x)
return(a*b/(a+b)^2/(a+b+1))}
})
-## source: http://mathworld.wolfram.com/BetaDistribution.html
+## source: https://mathworld.wolfram.com/BetaDistribution.html
setMethod("var", signature(x = "Arcsine"),
function(x, ...){
Modified: pkg/distrEx/R/HellingerDist.R
===================================================================
--- pkg/distrEx/R/HellingerDist.R 2018-07-08 14:23:40 UTC (rev 1180)
+++ pkg/distrEx/R/HellingerDist.R 2018-07-08 14:24:06 UTC (rev 1181)
@@ -39,6 +39,25 @@
return(sqrt(res)) # ^.5 added P.R. 19-12-06
})
+
+## new PR 08-09-16
+setMethod("HellingerDist", signature(e1 = "DiscreteMVDistribution",
+ e2 = "DiscreteMVDistribution"),
+ function(e1, e2, ...){
+ o.warn <- getOption("warn"); options(warn = -1)
+ on.exit(options(warn=o.warn))
+ ## replace univariate line supp <- union(support(e1), support(e2)) by
+
+ supp <- unique(rbind(support(e1), support(e2)))
+
+
+ res <- 0.5*sum((sqrt(d(e1)(supp))-sqrt(d(e2)(supp)))^2)
+ names(res) <- "Hellinger distance"
+
+ return(sqrt(res))
+ })
+
+
setMethod("HellingerDist", signature(e1 = "DiscreteDistribution",
e2 = "AbscontDistribution"),
function(e1, e2, ...){
Modified: pkg/distrEx/R/KolmogorovDist.R
===================================================================
--- pkg/distrEx/R/KolmogorovDist.R 2018-07-08 14:23:40 UTC (rev 1180)
+++ pkg/distrEx/R/KolmogorovDist.R 2018-07-08 14:24:06 UTC (rev 1181)
@@ -6,18 +6,18 @@
e2 = "AbscontDistribution"),
function(e1, e2){
TruncQuantile <- getdistrOption("TruncQuantile")
- lower1 <- ifelse(!is.finite(q(e1)(0)), q(e1)(TruncQuantile), q(e1)(0))
- upper1 <- ifelse(!is.finite(q(e1)(1)),
+ lower1 <- ifelse(!is.finite(q.l(e1)(0)), q.l(e1)(TruncQuantile), q.l(e1)(0))
+ upper1 <- ifelse(!is.finite(q.l(e1)(1)),
ifelse("lower.tail" %in% names(formals(e1 at q)),
- q(e1)(TruncQuantile, lower.tail = FALSE),
- q(e1)(1-TruncQuantile)),
- q(e1)(1))
- lower2 <- ifelse(!is.finite(q(e2)(0)), q(e2)(TruncQuantile), q(e2)(0))
- upper2 <- ifelse(!is.finite(q(e2)(1)),
+ q.l(e1)(TruncQuantile, lower.tail = FALSE),
+ q.l(e1)(1-TruncQuantile)),
+ q.l(e1)(1))
+ lower2 <- ifelse(!is.finite(q.l(e2)(0)), q.l(e2)(TruncQuantile), q.l(e2)(0))
+ upper2 <- ifelse(!is.finite(q.l(e2)(1)),
ifelse("lower.tail" %in% names(formals(e2 at q)),
- q(e2)(TruncQuantile, lower.tail = FALSE),
- q(e2)(1-TruncQuantile)),
- q(e2)(1))
+ q.l(e2)(TruncQuantile, lower.tail = FALSE),
+ q.l(e2)(1-TruncQuantile)),
+ q.l(e2)(1))
lower <- min(lower1, lower2)
upper <- max(upper1, upper2)
@@ -103,18 +103,18 @@
p = e2.erg$pfun, d = e2.erg$dfun, q = e2.erg$qfun,
.withSim = TRUE, .withArith = FALSE)}
TruncQuantile <- getdistrOption("TruncQuantile")
- lower1 <- ifelse(!is.finite(q(e1)(0)), q(e1)(TruncQuantile), q(e1)(0))
- upper1 <- ifelse(!is.finite(q(e1)(1)),
+ lower1 <- ifelse(!is.finite(q.l(e1)(0)), q.l(e1)(TruncQuantile), q.l(e1)(0))
+ upper1 <- ifelse(!is.finite(q.l(e1)(1)),
ifelse("lower.tail" %in% names(formals(e1 at q)),
- q(e1)(TruncQuantile, lower.tail = FALSE),
- q(e1)(1-TruncQuantile)),
- q(e1)(1))
- lower2 <- ifelse(!is.finite(q(e2)(0)), q(e2)(TruncQuantile), q(e2)(0))
- upper2 <- ifelse(!is.finite(q(e2)(1)),
+ q.l(e1)(TruncQuantile, lower.tail = FALSE),
+ q.l(e1)(1-TruncQuantile)),
+ q.l(e1)(1))
+ lower2 <- ifelse(!is.finite(q.l(e2)(0)), q.l(e2)(TruncQuantile), q.l(e2)(0))
+ upper2 <- ifelse(!is.finite(q.l(e2)(1)),
ifelse("lower.tail" %in% names(formals(e2 at q)),
- q(e2)(TruncQuantile, lower.tail = FALSE),
- q(e2)(1-TruncQuantile)),
- q(e2)(1))
+ q.l(e2)(TruncQuantile, lower.tail = FALSE),
+ q.l(e2)(1-TruncQuantile)),
+ q.l(e2)(1))
lower <- min(lower1, lower2)
upper <- max(upper1, upper2)
Modified: pkg/distrEx/R/Kurtosis.R
===================================================================
--- pkg/distrEx/R/Kurtosis.R 2018-07-08 14:23:40 UTC (rev 1180)
+++ pkg/distrEx/R/Kurtosis.R 2018-07-08 14:24:06 UTC (rev 1181)
@@ -99,7 +99,7 @@
p <- prob(x)
return((1-6*p*(1-p))/(size(x)*p*(1-p)))
})
-### source: http://mathworld.wolfram.com/BinomialDistribution.html
+### source: https://mathworld.wolfram.com/BinomialDistribution.html
#
setMethod("kurtosis", signature(x = "Cauchy"),
@@ -114,7 +114,7 @@
else
return(NA)
})
-### source http://mathworld.wolfram.com/CauchyDistribution.html
+### source https://mathworld.wolfram.com/CauchyDistribution.html
#
setMethod("kurtosis", signature(x = "Chisq"),
@@ -129,7 +129,7 @@
else
return(12*(df(x)+4*ncp(x))/(df(x)+2*ncp(x))^2)
})
-### source http://mathworld.wolfram.com/Chi-SquaredDistribution.html
+### source https://mathworld.wolfram.com/Chi-SquaredDistribution.html
#
setMethod("kurtosis", signature(x = "Dirac"),
@@ -209,7 +209,7 @@
}
}
})
-### source (without ncp) http://mathworld.wolfram.com/F-Distribution.html
+### source (without ncp) https://mathworld.wolfram.com/F-Distribution.html
#
setMethod("kurtosis", signature(x = "Gammad"),
function(x, ...){
@@ -224,7 +224,7 @@
return(6/shape(x))
})
-### source http://mathworld.wolfram.com/GammaDistribution.html
+### source https://mathworld.wolfram.com/GammaDistribution.html
#
setMethod("kurtosis", signature(x = "Geom"),
function(x, ...){
@@ -238,7 +238,7 @@
else
return(6+ prob(x)^2/(1-prob(x)))
})
-### source http://mathworld.wolfram.com/GeometricDistribution.html
+### source https://mathworld.wolfram.com/GeometricDistribution.html
#
setMethod("kurtosis", signature(x = "Hyper"),
function(x, ...){
@@ -260,7 +260,7 @@
)
}
})
-### source http://mathworld.wolfram.com/HypergeometricDistribution.html
+### source https://mathworld.wolfram.com/HypergeometricDistribution.html
#
setMethod("kurtosis", signature(x = "Logis"),
function(x, ...){
@@ -274,7 +274,7 @@
else
return(6/5)
})
-### source http://mathworld.wolfram.com/LogisticDistribution.html
+### source https://mathworld.wolfram.com/LogisticDistribution.html
#
setMethod("kurtosis", signature(x = "Lnorm"),
function(x, ...){
@@ -290,7 +290,7 @@
return( w^4+2*w^3+3*w^2-6)
}
})
-### source http://mathworld.wolfram.com/LogNormalDistribution.html
+### source https://mathworld.wolfram.com/LogNormalDistribution.html
#
setMethod("kurtosis", signature(x = "Nbinom"),
function(x, ...){
@@ -304,7 +304,7 @@
else
return(6/size(x)+prob(x)^2/(size(x)*(1-prob(x))))
})
-### source http://mathworld.wolfram.com/NegativeBinomialDistribution.html
+### source https://mathworld.wolfram.com/NegativeBinomialDistribution.html
#
setMethod("kurtosis", signature(x = "Pois"),
function(x, ...){
@@ -318,7 +318,7 @@
else
return(1/lambda(x))
})
-### source http://mathworld.wolfram.com/PoissonDistribution.html
+### source https://mathworld.wolfram.com/PoissonDistribution.html
#
setMethod("kurtosis", signature(x = "Td"),
function(x, ...){
@@ -343,7 +343,7 @@
}
}
})
-### source http://mathworld.wolfram.com/NoncentralStudentst-Distribution.html
+### source https://mathworld.wolfram.com/NoncentralStudentst-Distribution.html
#
setMethod("kurtosis", signature(x = "Unif"),
@@ -358,7 +358,7 @@
else
return(-6/5)
})
-### source http://mathworld.wolfram.com/UniformDistribution.html
+### source https://mathworld.wolfram.com/UniformDistribution.html
#
setMethod("kurtosis", signature(x = "Weibull"),
function(x, ...){
@@ -377,7 +377,7 @@
v <- (g2-g1^2)^2
return( (g4-4*g3*g1+6*g2*g1^2-3*g1^4)/v - 3 )
})
-### source http://mathworld.wolfram.com/WeibullDistribution.html
+### source https://mathworld.wolfram.com/WeibullDistribution.html
#
setMethod("kurtosis", signature(x = "Beta"),
function(x, ...){
@@ -392,7 +392,7 @@
{a<-shape1(x); b<- shape2(x)
return(6*(a^3-a^2*(2*b-1)+b^2*(b+1)-2*a*b*(b+2))/(a*b*(a+b+2)*(a+b+3)) )}
})
-## source: http://mathworld.wolfram.com/BetaDistribution.html
+## source: https://mathworld.wolfram.com/BetaDistribution.html
###################################################################################
#kurtosis --- code P.R.:
Modified: pkg/distrEx/R/LMCondDistribution.R
===================================================================
--- pkg/distrEx/R/LMCondDistribution.R 2018-07-08 14:23:40 UTC (rev 1180)
+++ pkg/distrEx/R/LMCondDistribution.R 2018-07-08 14:24:06 UTC (rev 1181)
@@ -90,7 +90,7 @@
intercept = intercept, theta = theta,
scale = scale))
- qfct <- q(Error)
+ qfct <- q.l(Error)
qfun <- function(p, cond, lower.tail = TRUE, log.p = FALSE, ...){}
body(qfun) <- substitute({ if(length(cond) != lth)
stop("'cond' has wrong dimension")
Modified: pkg/distrEx/R/OAsymTotalVarDist.R
===================================================================
--- pkg/distrEx/R/OAsymTotalVarDist.R 2018-07-08 14:23:40 UTC (rev 1180)
+++ pkg/distrEx/R/OAsymTotalVarDist.R 2018-07-08 14:24:06 UTC (rev 1181)
@@ -47,8 +47,8 @@
## 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.l(e1)(seq(TruncQuantile,1-TruncQuantile,length=Ngrid/3)))
+ x.range <- c(x.range, q.l(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)
@@ -244,8 +244,8 @@
### continuous part
## x-range:
x.range <- seq(low, up, length=Ngrid/3)
- x.range <- c(x.range, q(ac1)(seq(TruncQuantile,1-TruncQuantile,length=Ngrid/3)))
- x.range <- c(x.range, q(ac2)(seq(TruncQuantile,1-TruncQuantile,length=Ngrid/3)))
+ x.range <- c(x.range, q.l(ac1)(seq(TruncQuantile,1-TruncQuantile,length=Ngrid/3)))
+ x.range <- c(x.range, q.l(ac2)(seq(TruncQuantile,1-TruncQuantile,length=Ngrid/3)))
## to avoid division by 0:
d1x.range <- d10x.range <- ac1.d(x.range)
d1x.range <- d1x.range+(d1x.range<1e-20)
Modified: pkg/distrEx/R/PrognCondDistribution.R
===================================================================
--- pkg/distrEx/R/PrognCondDistribution.R 2018-07-08 14:23:40 UTC (rev 1180)
+++ pkg/distrEx/R/PrognCondDistribution.R 2018-07-08 14:24:06 UTC (rev 1181)
@@ -38,7 +38,7 @@
dxfun <- d(Regr)
dufun <- d(Error)
- qxfun <- q(Regr)
+ qxfun <- q.l(Regr)
Ib <- .getIntbounds(Error, low=-Inf, upp=Inf, lowerTruncQuantile,
upperTruncQuantile, IQR.fac)
@@ -84,7 +84,7 @@
},
[TRUNCATED]
To get the complete diff run:
svnlook diff /svnroot/distr -r 1181
More information about the Distr-commits
mailing list