[Distr-commits] r377 - branches/distr-2.1/pkg/distr/R pkg/distr/R

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

Author: ruckdeschel
Date: 2009-01-19 14:16:43 +0100 (Mon, 19 Jan 2009)
New Revision: 377

Modified:
   branches/distr-2.1/pkg/distr/R/DiscreteDistribution.R
   pkg/distr/R/DiscreteDistribution.R
Log:
fixed a bug discovered by Prof. Unwin  --- 
"+" trapped in a dead-lock coercing between DiscreteDistribution 
    and LatticeDistribution



Modified: branches/distr-2.1/pkg/distr/R/DiscreteDistribution.R
===================================================================
--- branches/distr-2.1/pkg/distr/R/DiscreteDistribution.R	2009-01-16 14:43:05 UTC (rev 376)
+++ branches/distr-2.1/pkg/distr/R/DiscreteDistribution.R	2009-01-19 13:16:43 UTC (rev 377)
@@ -5,7 +5,7 @@
 ## (c) Matthias Kohl: revised P.R. 030707
 
 DiscreteDistribution <- function(supp, prob, .withArith = FALSE,
-     .withSim = FALSE, .lowerExact = TRUE, .logExact = FALSE){
+     .withSim = FALSE){
     if(!is.numeric(supp))
         stop("'supp' is no numeric vector")
     if(any(!is.finite(supp)))   # admit +/- Inf?
@@ -54,8 +54,7 @@
                       .withSim, min(supp), max(supp), Cont = FALSE)
 
     object <- new("DiscreteDistribution", r = rfun, d = dfun, q = qfun, p=pfun,
-         support = supp, .withArith = .withArith, .withSim = .withSim,
-         .lowerExact = .lowerExact, .logExact = .logExact)
+         support = supp, .withArith = .withArith, .withSim = .withSim)
 }
 
 
@@ -206,7 +205,13 @@
             e1 <- as(e1, "LatticeDistribution")
             e2 <- as(e2, "LatticeDistribution")
             if(is(e1, "LatticeDistribution") & is(e2, "LatticeDistribution"))
-                return(e1 + e2)
+                {w1 <- width(lattice(e1))
+                 w2 <- width(lattice(e2))
+                 W <- sort(abs(c(w1,w2)))
+                 if (abs(abs(w1)-abs(w2))<getdistrOption("DistrResolution") ||
+                     W[2] %% W[1] < getdistrOption("DistrResolution") )
+                     return(e1 + e2)
+                } 
             convolutedsupport <- rep(support(e1), each = length(support(e2))) +
                                  support(e2)
 
@@ -347,8 +352,7 @@
 
             object <- new("DiscreteDistribution", r = rnew, p = pnew,
                            q = qnew, d = dnew, support = supportnew, 
-                           .withSim = x at .withSim, .withArith = TRUE,
-                           .lowerExact = x at .lowerExact)
+                           .withSim = x at .withSim, .withArith = TRUE)
             object
           })
 

Modified: pkg/distr/R/DiscreteDistribution.R
===================================================================
--- pkg/distr/R/DiscreteDistribution.R	2009-01-16 14:43:05 UTC (rev 376)
+++ pkg/distr/R/DiscreteDistribution.R	2009-01-19 13:16:43 UTC (rev 377)
@@ -205,7 +205,13 @@
             e1 <- as(e1, "LatticeDistribution")
             e2 <- as(e2, "LatticeDistribution")
             if(is(e1, "LatticeDistribution") & is(e2, "LatticeDistribution"))
-                return(e1 + e2)
+                {w1 <- width(lattice(e1))
+                 w2 <- width(lattice(e2))
+                 W <- sort(abs(c(w1,w2)))
+                 if (abs(abs(w1)-abs(w2))<getdistrOption("DistrResolution") ||
+                     W[2] %% W[1] < getdistrOption("DistrResolution") )
+                     return(e1 + e2)
+                } 
             convolutedsupport <- rep(support(e1), each = length(support(e2))) +
                                  support(e2)