[Distr-commits] r1142 - branches/distr-2.7/pkg/distr/R

[noreply at r-forge.r-project.org]

Author: ruckdeschel
Date: 2018-04-13 18:25:40 +0200 (Fri, 13 Apr 2018)
New Revision: 1142

Modified:
   branches/distr-2.7/pkg/distr/R/UnivarLebDecDistribution.R
   branches/distr-2.7/pkg/distr/R/internalUtils.R
Log:
distr:
## PR 2018 04 13
## detected by Tuomo.OJALA at 3ds.com:
## in a loop the names of slots acWeight, discreteWeight will grow;
## fix this by setting the prior names to NULL
## the gaps matrix can
## have zero rows -> check this in the following line
                   

Modified: branches/distr-2.7/pkg/distr/R/UnivarLebDecDistribution.R
===================================================================
--- branches/distr-2.7/pkg/distr/R/UnivarLebDecDistribution.R	2017-08-10 17:51:33 UTC (rev 1141)
+++ branches/distr-2.7/pkg/distr/R/UnivarLebDecDistribution.R	2018-04-13 16:25:40 UTC (rev 1142)
@@ -21,6 +21,14 @@
        if(discreteWeight <0 || acWeight<0 || acWeight+discreteWeight>1)
              stop("no proper weights given")
     }
+
+## PR 2018 04 13
+## detected by Tuomo.OJALA at 3ds.com:
+## in a loop the names of slots acWeight, discreteWeight will grow;
+## fix this by setting the prior names to NULL
+                       names(acWeight) <- NULL
+    names(discreteWeight) <- NULL
+
     if(discreteWeight > 1 - getdistrOption("TruncQuantile"))
        {return(
            new("UnivarLebDecDistribution", p = discretePart at p,
@@ -47,6 +55,7 @@
     mixDistr <- new("UnivarDistrList", list(acPart = acPart,
                      discretePart = discretePart))
     mixCoeff <- c(acWeight = acWeight, discreteWeight = discreteWeight)
+
     rnew <- function(n)
              {U <- rbinom(n, size = 1, prob = acWeight)
               AC <- acPart at r(n); DISCRETE <- discretePart at r(n)

Modified: branches/distr-2.7/pkg/distr/R/internalUtils.R
===================================================================
--- branches/distr-2.7/pkg/distr/R/internalUtils.R	2017-08-10 17:51:33 UTC (rev 1141)
+++ branches/distr-2.7/pkg/distr/R/internalUtils.R	2018-04-13 16:25:40 UTC (rev 1142)
@@ -268,7 +268,11 @@
 .isIn <- function(p0, pmat, tol = min( getdistrOption("TruncQuantile")/2,
                                           .Machine$double.eps^.7
                                           ))
-                  {list1 <- lapply(1:nrow(pmat), function(x){ 
+                  {## PR 2018 04 13
+                   ## detected by Tuomo.OJALA at 3ds.com: the gaps matrix can
+                   ## have zero rows -> check this in the following line
+                   if(nrow(pmat)==0) return(FALSE)
+                   list1 <- lapply(1:nrow(pmat), function(x){
                             (p0+tol > pmat[x,1]) & (p0-tol < pmat[x,2]) })
                    apply(matrix(unlist(list1), ncol = nrow(pmat)), 1, any)}