From noreply at r-forge.r-project.org Fri Apr 13 18:25:41 2018 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Fri, 13 Apr 2018 18:25:41 +0200 (CEST) Subject: [Distr-commits] r1142 - branches/distr-2.7/pkg/distr/R Message-ID: <20180413162541.8356D189DDD@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)}