[Distr-commits] r1358 - in branches/distr-2.9/pkg/distr: R inst
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Fri Sep 18 21:00:27 CEST 2020
Author: ruckdeschel
Date: 2020-09-18 21:00:27 +0200 (Fri, 18 Sep 2020)
New Revision: 1358
Modified:
branches/distr-2.9/pkg/distr/R/AllInitialize.R
branches/distr-2.9/pkg/distr/R/BinomialDistribution.R
branches/distr-2.9/pkg/distr/R/CompoundDistribution.R
branches/distr-2.9/pkg/distr/R/internalUtils_LCD.R
branches/distr-2.9/pkg/distr/inst/NEWS
Log:
[distr 2.9.0]: fixed ab bug deteced by Vlada Milchevskaya vmilchev at uni-koeln.de:
CompoundDistribution(): special treatment of case that NumbOfSummandsDistr is a Dirac distribution (and detect that for prob in {0,1} Binom(size, prob) is in fact a Dirac distribution)
Modified: branches/distr-2.9/pkg/distr/R/AllInitialize.R
===================================================================
--- branches/distr-2.9/pkg/distr/R/AllInitialize.R 2020-03-06 21:11:18 UTC (rev 1357)
+++ branches/distr-2.9/pkg/distr/R/AllInitialize.R 2020-09-18 19:00:27 UTC (rev 1358)
@@ -425,7 +425,7 @@
list(sizeSub = size, probSub = prob)
)
.Object at support = 0:size
- .Object at lattice = new("Lattice", pivot = 0, width = 1,
+ .Object at lattice = new("Lattice", pivot = 0, width = 1,
Length = size+1)
.Object at .withArith <- .withArith
.Object at .finSupport <- c(TRUE,TRUE)
Modified: branches/distr-2.9/pkg/distr/R/BinomialDistribution.R
===================================================================
--- branches/distr-2.9/pkg/distr/R/BinomialDistribution.R 2020-03-06 21:11:18 UTC (rev 1357)
+++ branches/distr-2.9/pkg/distr/R/BinomialDistribution.R 2020-09-18 19:00:27 UTC (rev 1358)
@@ -38,7 +38,16 @@
##
################################
-Binom <- function(size = 1,prob = 0.5) new("Binom", size = size, prob = prob)
+Binom <- function(size = 1,prob = 0.5){
+ if(length(size)!=1 || length(prob)!=1)
+ stop("Arguments 'size' and 'prob' must be of length 1")
+ if(!.isInteger(size) || size < 1 )
+ stop("Argument 'size' must be a positive integer")
+ if(prob < 0 || prob > 1 )
+ stop("Argument 'prob' must be in [0,1]")
+ if(!.isEqual01(prob)) return(new("Binom", size = size, prob = prob))
+ if(prob < 0.1) return(Dirac(0)) else return(Dirac(size))
+}
## wrapped access methods
setMethod("prob", "Binom", function(object) prob(param(object)))
Modified: branches/distr-2.9/pkg/distr/R/CompoundDistribution.R
===================================================================
--- branches/distr-2.9/pkg/distr/R/CompoundDistribution.R 2020-03-06 21:11:18 UTC (rev 1357)
+++ branches/distr-2.9/pkg/distr/R/CompoundDistribution.R 2020-09-18 19:00:27 UTC (rev 1358)
@@ -8,9 +8,10 @@
withSimplify = FALSE){
Symmetry <- NoSymmetry()
-
+
if(!is(NumbOfSummandsDistr,"DiscreteDistribution"))
stop("Argument 'NumbOfSummandsDistr' must be of class 'DiscreteDistribution'")
+
supp <- support(NumbOfSummandsDistr)
if(!(all(.isInteger(supp))&&all(supp >=0)))
stop("Support of 'NumbOfSummandsDistr' must be non neg. integers")
@@ -17,9 +18,19 @@
if(!is(SummandsDistr,"UnivDistrListOrDistribution"))
stop("Argument 'SummandsDistr' must be of class 'UnivDistrListOrDistribution'")
- supp <- support(NumbOfSummandsDistr)
+
+##20200918 can be deleted: supp <- support(NumbOfSummandsDistr)
+
supp <- as(supp,"integer")
suppNot0 <- supp[supp!=0L]
+
+ ## new 20200918 triggered by mail by Vlada Milchevskaya vmilchev at uni-koeln.de
+ ## special treatment of case support is of length 1
+ if(length(supp)==1L){
+ if(supp[1]==0L) return(Dirac(0))
+ return(convpow(SummandsDistr,supp[1]))
+ }
+
is0 <- 0 %in% supp
lI <- vector("list", length(supp))
if(is0) lI[[1]] <- Dirac(0)
@@ -33,7 +44,7 @@
S <- convpow(SummandsDistr,suppNot0[i])
# S <- S + x0
lI[[i+is0]] <- S
- }
+ }
Symmetry <- Symmetry(SummandsDistr)
}else{
supp <- min(supp):max(supp)
@@ -52,11 +63,11 @@
SymmL <- is(SymmI, "SphericalSymmetry")
if(SymmL)
SymmL <- .isEqual(SymmCenter(SymmI),SymmC)
- }
+ }
S <- S + SummandsDistr[[i]]
lI[[i+is0]] <- S
}
- if(SymmL) Symmetry <- SphericalSymmetry(SymmC)
+ if(SymmL) Symmetry <- SphericalSymmetry(SymmC)
}
UV <- do.call("UnivarMixingDistribution",
args = c(list(mixCoeff = d(NumbOfSummandsDistr)(supp),
Modified: branches/distr-2.9/pkg/distr/R/internalUtils_LCD.R
===================================================================
--- branches/distr-2.9/pkg/distr/R/internalUtils_LCD.R 2020-03-06 21:11:18 UTC (rev 1357)
+++ branches/distr-2.9/pkg/distr/R/internalUtils_LCD.R 2020-09-18 19:00:27 UTC (rev 1358)
@@ -205,7 +205,7 @@
## start patch 20200131 : in the last line added na.rm=TRUE
qL1[!is.finite(qL1)] <- NA
if(all(is.na(qL1))) qL1[1] <- Inf
- if(all(is.na(qL))) qL[1] <- Inf
+ if(all(is.na(qL0))) qL0[1] <- Inf
qL <- min(qL0, na.rm = TRUE); ql <- min(qL1, na.rm = TRUE)
## end patch 20200131
@@ -218,7 +218,7 @@
## start patch 20200131 : in the last line added na.rm=TRUE
qU1[!is.finite(qU1)] <- NA
if(all(is.na(qU1))) qU1[1] <- -Inf
- if(all(is.na(qU))) qU[1] <- -Inf
+ if(all(is.na(qU0))) qU0[1] <- -Inf
qU <- max(qU0, na.rm = TRUE); qu <- max(qU1, na.rm = TRUE)
## end patch 20200131
Modified: branches/distr-2.9/pkg/distr/inst/NEWS
===================================================================
--- branches/distr-2.9/pkg/distr/inst/NEWS 2020-03-06 21:11:18 UTC (rev 1357)
+++ branches/distr-2.9/pkg/distr/inst/NEWS 2020-09-18 19:00:27 UTC (rev 1358)
@@ -19,6 +19,9 @@
under the hood:
+ triggered by an email by Santhosh V <Santhosh.V at se.com>, we added a patch to be more careful when producing
slot q for compound and mixing distributions
++ detected by Vlada Milchevskaya vmilchev at uni-koeln.de:
+ CompoundDistribution(): special treatment of case that NumbOfSummandsDistr is a Dirac distribution
+ (and detect that for prob in {0,1} Binom(size, prob) is in fact a Dirac distribution)
##############
v 2.8
More information about the Distr-commits
mailing list