[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