[Distr-commits] r1416 - branches/distr-2.9/pkg/distr/R branches/distr-2.9/pkg/distr/inst branches/distr-2.9/pkg/distr/man branches/distr-2.9/pkg/distrEx/R pkg/distr/R pkg/distr/inst pkg/distrEx/R pkg/utils
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Tue Sep 19 17:57:20 CEST 2023
Author: ruckdeschel
Date: 2023-09-19 17:57:19 +0200 (Tue, 19 Sep 2023)
New Revision: 1416
Modified:
branches/distr-2.9/pkg/distr/R/DiscreteDistribution.R
branches/distr-2.9/pkg/distr/inst/NEWS
branches/distr-2.9/pkg/distr/man/0distr-package.Rd
branches/distr-2.9/pkg/distrEx/R/Functionals.R
pkg/distr/R/DiscreteDistribution.R
pkg/distr/R/bAcDcLcDistribution.R
pkg/distr/R/flat.R
pkg/distr/inst/NEWS
pkg/distrEx/R/distrExIntegrate.R
pkg/utils/R.bat
pkg/utils/RBuild.bat
Log:
+ fixed a glitch in distr::"+"("DiscreteDistribution","DiscreteDistribution") as
spotted by christoph.dalitz at hs-niederrhein.de in both devel and release branch
+ some remainders from a bug fix in July in distrEx::functionals.R
and in a bug fix from July in release branch
+ and finally for R-package development in Windows some update for the batch utilities
Modified: branches/distr-2.9/pkg/distr/R/DiscreteDistribution.R
===================================================================
--- branches/distr-2.9/pkg/distr/R/DiscreteDistribution.R 2023-07-20 12:57:18 UTC (rev 1415)
+++ branches/distr-2.9/pkg/distr/R/DiscreteDistribution.R 2023-09-19 15:57:19 UTC (rev 1416)
@@ -236,11 +236,12 @@
w2 <- width(lattice(e2.L))
W <- sort(abs(c(w1,w2)))
if (abs(abs(w1)-abs(w2))<getdistrOption("DistrResolution") ||
- W[2] %% W[1] < getdistrOption("DistrResolution") )
+ W[2] %% W[1] < getdistrOption("DistrResolution") ){
res <- e1.L + e2.L
res at .finSupport <- e1.L at .finSupport&e2.L at .finSupport
return(res)
- }
+ }
+ }
res <- .convDiscrDiscr(e1,e2)
res at .finSupport <- e1 at .finSupport&e2 at .finSupport
return(res)
Modified: branches/distr-2.9/pkg/distr/inst/NEWS
===================================================================
--- branches/distr-2.9/pkg/distr/inst/NEWS 2023-07-20 12:57:18 UTC (rev 1415)
+++ branches/distr-2.9/pkg/distr/inst/NEWS 2023-09-19 15:57:19 UTC (rev 1416)
@@ -15,6 +15,8 @@
when multiplying DiscreteDistributions, the positive and negative parts of
which are Dirac Distributions, .finSupport was not returned of length 2
(as needed),
++ fixed a glitch in "+"("DiscreteDistribution","DiscreteDistribution") as
+ spotted by christoph.dalitz at hs-niederrhein.de
##############
Modified: branches/distr-2.9/pkg/distr/man/0distr-package.Rd
===================================================================
--- branches/distr-2.9/pkg/distr/man/0distr-package.Rd 2023-07-20 12:57:18 UTC (rev 1415)
+++ branches/distr-2.9/pkg/distr/man/0distr-package.Rd 2023-09-19 15:57:19 UTC (rev 1416)
@@ -44,7 +44,7 @@
\details{
\tabular{ll}{
Package: \tab distr \cr
-Version: \tab 2.9.1 \cr
+Version: \tab 2.9.3 \cr
Date: \tab 2022-11-14 \cr
Depends: \tab R(>= 3.4), methods, graphics, startupmsg, sfsmisc \cr
Suggests: \tab distrEx, svUnit (>= 0.7-11), knitr, distrMod, ROptEst \cr
Modified: branches/distr-2.9/pkg/distrEx/R/Functionals.R
===================================================================
--- branches/distr-2.9/pkg/distrEx/R/Functionals.R 2023-07-20 12:57:18 UTC (rev 1415)
+++ branches/distr-2.9/pkg/distrEx/R/Functionals.R 2023-09-19 15:57:19 UTC (rev 1416)
@@ -9,7 +9,8 @@
function(x, fun = function(t) {t}, cond, withCond = FALSE, useApply = TRUE,
...){
if(missing(useApply)) useApply <- TRUE
- dots <- list(...)
+ dots <- match.call(call = sys.call(sys.parent(1)),
+ expand.dots = FALSE)$"..."
low <- -Inf; upp <- Inf
if(hasArg(low)) low <- dots$low
if(hasArg(upp)) upp <- dots$upp
@@ -87,14 +88,15 @@
################################################################################
setMethod("sd", signature(x = "UnivariateDistribution"),
function(x, fun, cond, withCond = FALSE, useApply = TRUE,
- propagate.names=getdistrExOption("propagate.names.functionals"), ...){
+ propagate.names = getdistrExOption("propagate.names.functionals"), ...){
propagate.names0 <- propagate.names
- dots <- list(...)
+ dots <- match.call(call = sys.call(sys.parent(1)),
+ expand.dots = FALSE)$"..."
dots$propagate.names <- NULL
if(missing(fun))
{if(missing(cond))
return(sqrt(do.call(var,c(list(x, useApply = useApply,
- propagate.names=propagate.names0),dots))))
+ propagate.names = propagate.names0),dots))))
else
return(sqrt(do.call(var,c(list(x, cond =cond, withCond = FALSE,
useApply = useApply, dots)))))
@@ -110,7 +112,7 @@
### overload "sd" method for "Norm" ...
setMethod("sd", signature(x = "Norm"),
function(x, fun, cond, withCond = FALSE, useApply = TRUE,
- propagate.names=getdistrExOption("propagate.names.functionals"), ...){
+ propagate.names = getdistrExOption("propagate.names.functionals"), ...){
if(missing(fun))
{if(missing(cond)){
ret.v <- sd(param(x))
@@ -159,7 +161,7 @@
if(is(Symmetry(x),"SphericalSymmetry"))
return(q.l(x)(3/4))
m <- median(x)
- y <- abs(x-m)
+ y <- abs(x - m)
return(q.l(y)(1/2))
})
@@ -182,11 +184,11 @@
setMethod("IQR", signature(x = "UnivariateCondDistribution"),
function(x, cond){
- return(q.l(x)(3/4, cond = cond)-q.l(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.l(x)(1/4)
+ function(x) q.r(x)(3/4) - q.l(x)(1/4)
)
setMethod("IQR", signature(x = "AffLinDistribution"),
@@ -211,7 +213,7 @@
# some exact variances:
#################################################################
setMethod("var", signature(x = "Norm"),
- function(x, propagate.names=getdistrExOption("propagate.names.functionals"),...){
+ function(x, propagate.names = getdistrExOption("propagate.names.functionals"),...){
dots <- match.call(call = sys.call(sys.parent(1)),
expand.dots = FALSE)$"..."
fun <- NULL; cond <- NULL; low <- NULL; upp <- NULL
@@ -226,7 +228,7 @@
})
setMethod("var", signature(x = "Binom"),
- function(x, propagate.names=getdistrExOption("propagate.names.functionals"),...){
+ function(x, propagate.names = getdistrExOption("propagate.names.functionals"),...){
dots <- match.call(call = sys.call(sys.parent(1)),
expand.dots = FALSE)$"..."
fun <- NULL; cond <- NULL; low <- NULL; upp <- NULL
@@ -257,7 +259,7 @@
### source https://mathworld.wolfram.com/CauchyDistribution.html
setMethod("var", signature(x = "Chisq"),
- function(x, propagate.names=getdistrExOption("propagate.names.functionals"),...){
+ function(x, propagate.names = getdistrExOption("propagate.names.functionals"),...){
dots <- match.call(call = sys.call(sys.parent(1)),
expand.dots = FALSE)$"..."
fun <- NULL; cond <- NULL; low <- NULL; upp <- NULL
@@ -291,7 +293,7 @@
### source https://mathworld.wolfram.com/LaplaceDistribution.html
setMethod("var", signature(x = "Exp"),
- function(x, propagate.names=getdistrExOption("propagate.names.functionals"), ...){
+ function(x, propagate.names = getdistrExOption("propagate.names.functionals"), ...){
dots <- match.call(call = sys.call(sys.parent(1)),
expand.dots = FALSE)$"..."
fun <- NULL; cond <- NULL; low <- NULL; upp <- NULL
@@ -308,7 +310,7 @@
### source https://mathworld.wolfram.com/ExponentialDistribution.html
setMethod("var", signature(x = "Fd"),
- function(x, propagate.names=getdistrExOption("propagate.names.functionals"), ...){
+ function(x, propagate.names = getdistrExOption("propagate.names.functionals"), ...){
dots <- match.call(call = sys.call(sys.parent(1)),
expand.dots = FALSE)$"..."
fun <- NULL; cond <- NULL; low <- NULL; upp <- NULL
@@ -328,7 +330,7 @@
### source (without ncp) https://mathworld.wolfram.com/F-Distribution.html
setMethod("var", signature(x = "Gammad"),
- function(x, propagate.names=getdistrExOption("propagate.names.functionals"), ...){
+ function(x, propagate.names = getdistrExOption("propagate.names.functionals"), ...){
dots <- match.call(call = sys.call(sys.parent(1)),
expand.dots = FALSE)$"..."
fun <- NULL; cond <- NULL; low <- NULL; upp <- NULL
@@ -344,7 +346,7 @@
### source https://mathworld.wolfram.com/GammaDistribution.html
setMethod("var", signature(x = "Geom"),
- function(x, propagate.names=getdistrExOption("propagate.names.functionals"), ...){
+ function(x, propagate.names = getdistrExOption("propagate.names.functionals"), ...){
dots <- match.call(call = sys.call(sys.parent(1)),
expand.dots = FALSE)$"..."
fun <- NULL; cond <- NULL; low <- NULL; upp <- NULL
@@ -362,7 +364,7 @@
### source https://mathworld.wolfram.com/GeometricDistribution.html
setMethod("var", signature(x = "Hyper"),
- function(x, propagate.names=getdistrExOption("propagate.names.functionals"), ...){
+ function(x, propagate.names = getdistrExOption("propagate.names.functionals"), ...){
dots <- match.call(call = sys.call(sys.parent(1)),
expand.dots = FALSE)$"..."
fun <- NULL; cond <- NULL; low <- NULL; upp <- NULL
@@ -381,7 +383,7 @@
### source https://mathworld.wolfram.com/HypergeometricDistribution.html
setMethod("var", signature(x = "Logis"),
- function(x, propagate.names=getdistrExOption("propagate.names.functionals"), ...){
+ function(x, propagate.names = getdistrExOption("propagate.names.functionals"), ...){
dots <- match.call(call = sys.call(sys.parent(1)),
expand.dots = FALSE)$"..."
fun <- NULL; cond <- NULL; low <- NULL; upp <- NULL
@@ -398,7 +400,7 @@
### source https://mathworld.wolfram.com/LogisticDistribution.html
setMethod("var", signature(x = "Lnorm"),
- function(x, propagate.names=getdistrExOption("propagate.names.functionals"), ...){
+ function(x, propagate.names = getdistrExOption("propagate.names.functionals"), ...){
dots <- match.call(call = sys.call(sys.parent(1)),
expand.dots = FALSE)$"..."
fun <- NULL; cond <- NULL; low <- NULL; upp <- NULL
@@ -415,7 +417,7 @@
### source https://mathworld.wolfram.com/LogNormalDistribution.html
setMethod("var", signature(x = "Nbinom"),
- function(x, propagate.names=getdistrExOption("propagate.names.functionals"), ...){
+ function(x, propagate.names = getdistrExOption("propagate.names.functionals"), ...){
dots <- match.call(call = sys.call(sys.parent(1)),
expand.dots = FALSE)$"..."
fun <- NULL; cond <- NULL; low <- NULL; upp <- NULL
@@ -433,7 +435,7 @@
### source https://mathworld.wolfram.com/NegativeBinomialDistribution.html
setMethod("var", signature(x = "Pois"),
- function(x, propagate.names=getdistrExOption("propagate.names.functionals"), ...){
+ function(x, propagate.names = getdistrExOption("propagate.names.functionals"), ...){
dots <- match.call(call = sys.call(sys.parent(1)),
expand.dots = FALSE)$"..."
fun <- NULL; cond <- NULL; low <- NULL; upp <- NULL
@@ -450,7 +452,7 @@
### source https://mathworld.wolfram.com/PoissonDistribution.html
setMethod("var", signature(x = "Td"),
- function(x, propagate.names=getdistrExOption("propagate.names.functionals"), ...){
+ function(x, propagate.names = getdistrExOption("propagate.names.functionals"), ...){
dots <- match.call(call = sys.call(sys.parent(1)),
expand.dots = FALSE)$"..."
fun <- NULL; cond <- NULL; low <- NULL; upp <- NULL
@@ -459,7 +461,7 @@
if(hasArg(fun)||hasArg(cond)||!is.null(low)||!is.null(upp))
return(var(as(x,"AbscontDistribution"),...))
else
- {n <- df(x); d<- ncp(x)
+ {n <- df(x); d <- ncp(x)
## correction thanks to G.Jay Kerns ### corrected again P.R.
ret.v <- ifelse( n>2, n/(n-2)*(1+d^2)
-d^2*n/2*exp(2*(lgamma((n-1)/2)-lgamma(n/2))), NA)
@@ -471,7 +473,7 @@
### source https://mathworld.wolfram.com/NoncentralStudentst-Distribution.html
setMethod("var", signature(x = "Unif"),
- function(x, propagate.names=getdistrExOption("propagate.names.functionals"), ...){
+ function(x, propagate.names = getdistrExOption("propagate.names.functionals"), ...){
dots <- match.call(call = sys.call(sys.parent(1)),
expand.dots = FALSE)$"..."
fun <- NULL; cond <- NULL; low <- NULL; upp <- NULL
@@ -488,7 +490,7 @@
### source https://mathworld.wolfram.com/UniformDistribution.html
setMethod("var", signature(x = "Weibull"),
- function(x, propagate.names=getdistrExOption("propagate.names.functionals"), ...){
+ function(x, propagate.names = getdistrExOption("propagate.names.functionals"), ...){
dots <- match.call(call = sys.call(sys.parent(1)),
expand.dots = FALSE)$"..."
fun <- NULL; cond <- NULL; low <- NULL; upp <- NULL
@@ -506,7 +508,7 @@
### source https://mathworld.wolfram.com/WeibullDistribution.html
setMethod("var", signature(x = "Beta"),
- function(x, propagate.names=getdistrExOption("propagate.names.functionals"), ...){
+ function(x, propagate.names = getdistrExOption("propagate.names.functionals"), ...){
dots <- match.call(call = sys.call(sys.parent(1)),
expand.dots = FALSE)$"..."
fun <- NULL; cond <- NULL; low <- NULL; upp <- NULL
@@ -541,7 +543,7 @@
#################################################################
setMethod("median", signature(x = "Norm"),
- function(x, propagate.names=getdistrExOption("propagate.names.functionals")){
+ function(x, propagate.names = getdistrExOption("propagate.names.functionals")){
ret.v <- mean(x)
if(!propagate.names){names(ret.v) <- NULL}
return(ret.v)
@@ -549,7 +551,7 @@
)
setMethod("median", signature(x = "Cauchy"),
- function(x, propagate.names=getdistrExOption("propagate.names.functionals")){
+ function(x, propagate.names = getdistrExOption("propagate.names.functionals")){
ret.v <- location(x)
if(!propagate.names){names(ret.v) <- NULL}
return(ret.v)
@@ -557,7 +559,7 @@
)
setMethod("median", signature(x = "Dirac"),
- function(x, propagate.names=getdistrExOption("propagate.names.functionals")){
+ function(x, propagate.names = getdistrExOption("propagate.names.functionals")){
ret.v <- location(x)
if(!propagate.names){names(ret.v) <- NULL}
return(ret.v)
@@ -568,7 +570,7 @@
function(x) 0)
setMethod("median", signature(x = "Exp"),
- function(x, propagate.names=getdistrExOption("propagate.names.functionals")){
+ function(x, propagate.names = getdistrExOption("propagate.names.functionals")){
ret.v <- log(2)/rate(x)
if(!propagate.names){names(ret.v) <- NULL}
return(ret.v)
@@ -576,7 +578,7 @@
)
setMethod("median", signature(x = "Geom"),
- function(x, propagate.names=getdistrExOption("propagate.names.functionals")){
+ function(x, propagate.names = getdistrExOption("propagate.names.functionals")){
ret.v <- ceiling(-log(2)/log(1-prob(x))-1)
if(!propagate.names){names(ret.v) <- NULL}
return(ret.v)
@@ -584,7 +586,7 @@
)
setMethod("median", signature(x = "Logis"),
- function(x, propagate.names=getdistrExOption("propagate.names.functionals")){
+ function(x, propagate.names = getdistrExOption("propagate.names.functionals")){
ret.v <- location(x)
if(!propagate.names){names(ret.v) <- NULL}
return(ret.v)
@@ -592,7 +594,7 @@
)
setMethod("median", signature(x = "Lnorm"),
- function(x, propagate.names=getdistrExOption("propagate.names.functionals")){
+ function(x, propagate.names = getdistrExOption("propagate.names.functionals")){
ret.v <- exp(meanlog(x))
if(!propagate.names){names(ret.v) <- NULL}
return(ret.v)
@@ -600,7 +602,7 @@
)
setMethod("median", signature(x = "Unif"),
- function(x, propagate.names=getdistrExOption("propagate.names.functionals")){
+ function(x, propagate.names = getdistrExOption("propagate.names.functionals")){
ret.v <- (Max(x)+Min(x))/2
if(!propagate.names){names(ret.v) <- NULL}
return(ret.v)
@@ -616,7 +618,7 @@
#################################################################
setMethod("IQR", signature(x = "Norm"),
- function(x, propagate.names=getdistrExOption("propagate.names.functionals")){
+ function(x, propagate.names = getdistrExOption("propagate.names.functionals")){
ret.v <- 2*qnorm(3/4)*sd(x)
if(!propagate.names){names(ret.v) <- NULL}
return(ret.v)
@@ -624,7 +626,7 @@
)
setMethod("IQR", signature(x = "Cauchy"),
- function(x, propagate.names=getdistrExOption("propagate.names.functionals")){
+ function(x, propagate.names = getdistrExOption("propagate.names.functionals")){
ret.v <- 2*scale(x)*qcauchy(3/4)
if(!propagate.names){names(ret.v) <- NULL}
return(ret.v)
@@ -638,7 +640,7 @@
function(x) 2*log(2))
setMethod("IQR", signature(x = "Exp"),
- function(x, propagate.names=getdistrExOption("propagate.names.functionals")){
+ function(x, propagate.names = getdistrExOption("propagate.names.functionals")){
ret.v <- (log(4)-log(4/3))/rate(x)
if(!propagate.names){names(ret.v) <- NULL}
return(ret.v)
@@ -646,7 +648,7 @@
)
setMethod("IQR", signature(x = "Geom"),
- function(x, propagate.names=getdistrExOption("propagate.names.functionals")){
+ function(x, propagate.names = getdistrExOption("propagate.names.functionals")){
ret.v <- ceiling(log(1/4)/log(1-prob(x)))-
max(floor(log(3/4)/log(1-prob(x))),0)
if(!propagate.names){names(ret.v) <- NULL}
@@ -655,7 +657,7 @@
)
setMethod("IQR", signature(x = "Logis"),
- function(x, propagate.names=getdistrExOption("propagate.names.functionals")){
+ function(x, propagate.names = getdistrExOption("propagate.names.functionals")){
ret.v <- 2*log(3)*scale(x)
if(!propagate.names){names(ret.v) <- NULL}
return(ret.v)
@@ -663,7 +665,7 @@
)
setMethod("IQR", signature(x = "Unif"),
- function(x, propagate.names=getdistrExOption("propagate.names.functionals")){
+ function(x, propagate.names = getdistrExOption("propagate.names.functionals")){
ret.v <- (Max(x)-Min(x))/2
if(!propagate.names){names(ret.v) <- NULL}
return(ret.v)
@@ -678,7 +680,7 @@
#################################################################
setMethod("mad", signature(x = "Norm"),
- function(x, propagate.names=getdistrExOption("propagate.names.functionals")){
+ function(x, propagate.names = getdistrExOption("propagate.names.functionals")){
ret.v <- qnorm(3/4)*sd(x)
if(!propagate.names){names(ret.v) <- NULL}
return(ret.v)
@@ -686,7 +688,7 @@
)
setMethod("mad", signature(x = "Cauchy"),
- function(x, propagate.names=getdistrExOption("propagate.names.functionals")){
+ function(x, propagate.names = getdistrExOption("propagate.names.functionals")){
ret.v <- scale(x)*qcauchy(3/4)
if(!propagate.names){names(ret.v) <- NULL}
return(ret.v)
@@ -700,7 +702,7 @@
function(x) log(2))
setMethod("mad", signature(x = "Exp"),
- function(x, propagate.names=getdistrExOption("propagate.names.functionals")){
+ function(x, propagate.names = getdistrExOption("propagate.names.functionals")){
ret.v <- log((1+sqrt(5))/2)/rate(x)
if(!propagate.names){names(ret.v) <- NULL}
return(ret.v)
@@ -708,7 +710,7 @@
)
setMethod("mad", signature(x = "Geom"),
- function(x, propagate.names=getdistrExOption("propagate.names.functionals")) {
+ function(x, propagate.names = getdistrExOption("propagate.names.functionals")) {
p <- prob(x); pq <- 1-p
m <- median(x); rho <- 1/2*pq^(-m)
ret.v <- max(ceiling(-log(rho/2+sqrt(pq+rho^2/4))/log(pq)),0)
@@ -717,7 +719,7 @@
})
setMethod("mad", signature(x = "Logis"),
- function(x, propagate.names=getdistrExOption("propagate.names.functionals")){
+ function(x, propagate.names = getdistrExOption("propagate.names.functionals")){
ret.v <- log(3)*scale(x)
if(!propagate.names){names(ret.v) <- NULL}
return(ret.v)
@@ -725,7 +727,7 @@
)
setMethod("mad", signature(x = "Unif"),
- function(x, propagate.names=getdistrExOption("propagate.names.functionals")){
+ function(x, propagate.names = getdistrExOption("propagate.names.functionals")){
ret.v <- (Max(x)-Min(x))/4
if(!propagate.names){names(ret.v) <- NULL}
return(ret.v)
Modified: pkg/distr/R/DiscreteDistribution.R
===================================================================
--- pkg/distr/R/DiscreteDistribution.R 2023-07-20 12:57:18 UTC (rev 1415)
+++ pkg/distr/R/DiscreteDistribution.R 2023-09-19 15:57:19 UTC (rev 1416)
@@ -236,10 +236,11 @@
w2 <- width(lattice(e2.L))
W <- sort(abs(c(w1,w2)))
if (abs(abs(w1)-abs(w2))<getdistrOption("DistrResolution") ||
- W[2] %% W[1] < getdistrOption("DistrResolution") )
+ W[2] %% W[1] < getdistrOption("DistrResolution") ){
res <- e1.L + e2.L
res at .finSupport <- e1.L at .finSupport&e2.L at .finSupport
return(res)
+ }
}
res <- .convDiscrDiscr(e1,e2)
res at .finSupport <- e1 at .finSupport&e2 at .finSupport
Modified: pkg/distr/R/bAcDcLcDistribution.R
===================================================================
--- pkg/distr/R/bAcDcLcDistribution.R 2023-07-20 12:57:18 UTC (rev 1415)
+++ pkg/distr/R/bAcDcLcDistribution.R 2023-09-19 15:57:19 UTC (rev 1416)
@@ -36,7 +36,11 @@
e12pp.f <- discretePart(e1DC$pos$D)@.finSupport[2] &
discretePart(e2DC$pos$D)@.finSupport[2]
d12pp <- discretePart(e12pp)
- d12pp at .finSupport <- e12pp.f
+ ## 20230720: detected by Christoph Dalitz <christoph.dalitz at hs-niederrhein.de>
+ ## concerns lines 43, 53, 63, and 76
+ ## .finSupport must a vector of length 2,
+ ## pops up if all e12pp, e12pm, e12mp, e12mm are Dirac distributions
+ d12pp at .finSupport <- c(TRUE,e12pp.f)
discretePart(e12pp) <- d12pp
e12mm <- if(w12mm>ep)
@@ -46,7 +50,7 @@
e12mm.f <- discretePart(e1DC$neg$D)@.finSupport[1]&
discretePart(e2DC$neg$D)@.finSupport[1]
d12mm <- discretePart(e12mm)
- d12mm at .finSupport <- e12mm.f
+ d12mm at .finSupport <- c(TRUE,e12mm.f)
discretePart(e12mm) <- d12mm
e12pm <- if(w12pm>ep)
@@ -56,7 +60,7 @@
e12pm.f <- discretePart(e1DC$pos$D)@.finSupport[2] &
discretePart(e2DC$neg$D)@.finSupport[1]
d12pm <- discretePart(e12pm)
- d12pm at .finSupport <- e12pm.f
+ d12pm at .finSupport <- c(e12pm.f,TRUE)
discretePart(e12pm) <- d12pm
if(identical(e1,e2)){
@@ -69,7 +73,7 @@
e12mp.f <- discretePart(e1DC$neg$D)@.finSupport[1] &
discretePart(e2DC$pos$D)@.finSupport[2]
d12mp <- discretePart(e12mp)
- d12mp at .finSupport <- e12mp.f
+ d12mp at .finSupport <- c(e12mp.f,TRUE)
discretePart(e12mp) <- d12mp
}
e12pm <- .del0dmixfun(e12pm)
Modified: pkg/distr/R/flat.R
===================================================================
--- pkg/distr/R/flat.R 2023-07-20 12:57:18 UTC (rev 1415)
+++ pkg/distr/R/flat.R 2023-09-19 15:57:19 UTC (rev 1416)
@@ -50,6 +50,9 @@
finSupport <- c(TRUE,TRUE)
if(l.d>0){
mixDistr.dfs <- sapply(mixDistr.d, function(x) x at .finSupport)
+ ## 20230720: detected by Christoph Dalitz <christoph.dalitz at hs-niederrhein.de>
+ ## can be a vector if the list elements are all Dirac distributions
+ if(is.null(dim(mixDistr.dfs))) mixDistr.dfs <- matrix(mixDistr.dfs,nrow=1)
finSupport <- apply(mixDistr.dfs,1,all)
}
if(l.c){
Modified: pkg/distr/inst/NEWS
===================================================================
--- pkg/distr/inst/NEWS 2023-07-20 12:57:18 UTC (rev 1415)
+++ pkg/distr/inst/NEWS 2023-09-19 15:57:19 UTC (rev 1416)
@@ -8,6 +8,13 @@
information)
##############
+v 2.9.3
+##############
+bug fixes:
++ fixed a glitch in "+"("DiscreteDistribution","DiscreteDistribution") as spotted by christoph.dalitz at hs-niederrhein.de
+
+
+##############
v 2.9.2
##############
under the hood:
Modified: pkg/distrEx/R/distrExIntegrate.R
===================================================================
--- pkg/distrEx/R/distrExIntegrate.R 2023-07-20 12:57:18 UTC (rev 1415)
+++ pkg/distrEx/R/distrExIntegrate.R 2023-09-19 15:57:19 UTC (rev 1416)
@@ -1,4 +1,4 @@
-# Gauß-Legendre abscissas and weights
+# Gauss-Legendre abscissas and weights
# cf. for example Numerical Recipies in C (1992), p. 152
#implementation in S:
Modified: pkg/utils/R.bat
===================================================================
--- pkg/utils/R.bat 2023-07-20 12:57:18 UTC (rev 1415)
+++ pkg/utils/R.bat 2023-09-19 15:57:19 UTC (rev 1416)
@@ -1,4 +1,3 @@
-
@echo off
rem if /i "%1"==path (path %2) && goto:eof
@@ -85,7 +84,7 @@
set path2=%path2:~1%
if defined R_TOOLS (
- set path2=%R_TOOLS%\bin;%R_TOOLS%\perl\bin;%R_TOOLS%\MinGW\bin;%PATH2%
+REM set path2=%R_TOOLS%\bin;%R_TOOLS%\perl\bin;%R_TOOLS%\MinGW\bin;%PATH2%
)
path %path2%
Modified: pkg/utils/RBuild.bat
===================================================================
--- pkg/utils/RBuild.bat 2023-07-20 12:57:18 UTC (rev 1415)
+++ pkg/utils/RBuild.bat 2023-09-19 15:57:19 UTC (rev 1416)
@@ -1,3 +1,3 @@
@echo off
-call R CMD build --compact-vignettes="gs+qpdf" --resave-data %1
+call R CMD build --compact-vignettes="gs+qpdf" --compression="best" --resave-data --md5 %1
echo on
More information about the Distr-commits
mailing list