[Distr-commits] r189 - branches/distr-2.0/pkg/distr/R

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

Author: stamats
Date: 2008-07-22 15:18:07 +0200 (Tue, 22 Jul 2008)
New Revision: 189

Modified:
   branches/distr-2.0/pkg/distr/R/internalUtils.R
Log:
check only numbers not attributes ...
Causes errors if "names" attribute is filled.

Modified: branches/distr-2.0/pkg/distr/R/internalUtils.R
===================================================================
--- branches/distr-2.0/pkg/distr/R/internalUtils.R	2008-07-21 07:10:16 UTC (rev 188)
+++ branches/distr-2.0/pkg/distr/R/internalUtils.R	2008-07-22 13:18:07 UTC (rev 189)
@@ -15,7 +15,8 @@
   {    ### is x equally spaced?
     all( sapply(diff(x), function(y)
          isTRUE(all.equal(y, diff(x)[1],
-                tolerance = getdistrOption("DistrResolution")))))
+                tolerance = getdistrOption("DistrResolution"),
+                check.attributes = FALSE))))
   }
 
 ### internal help function to check consistency of lattice with support:
@@ -27,14 +28,15 @@
    if (! .is.vector.lattice(support)  && eq.space)
       return(FALSE)
    ### are width of lattice and support consistent
-   if (! isTRUE(all.equal(min(ds),abs(w))))
+   if (! isTRUE(all.equal(min(ds), abs(w), check.attributes = FALSE)))
       return(FALSE)
    ### pivot is left or right endpoint of support
-   if ( isTRUE(all.equal(ms,p)) || isTRUE(all.equal(Ms,p)) )
+   if ( isTRUE(all.equal(ms, p, check.attributes = FALSE)) || isTRUE(all.equal(Ms, p, check.attributes = FALSE)) )
       return(TRUE)
 
    if (isTRUE(all.equal(min((support[1]-p)%%w,w-(support[1]-p)%%w),0,
-                         tolerance = getdistrOption("TruncQuantile"))))
+                        tolerance = getdistrOption("TruncQuantile"),
+                        check.attributes = FALSE)))
       return(TRUE)
   return(FALSE)
   }
@@ -358,7 +360,7 @@
 
 .plusm <- function(e1, e2, Dclass = "DiscreteDistribution"){
             if (length(e2)>1) stop("length of operator must be 1")
-            if (isTRUE(all.equal(e2,0))) return(e1)
+            if (isTRUE(all.equal(e2, 0, check.attributes = FALSE))) return(e1)
 
             if ((Dclass == "DiscreteDistribution")||
                 (Dclass == "AffLinDiscreteDistribution"))
@@ -410,8 +412,8 @@
 .multm <- function(e1, e2, Dclass = "DiscreteDistribution"){
             if (length(e2)>1) stop("length of operator must be 1")
 
-            if (isTRUE(all.equal(e2,1))) return(e1)
-            if (isTRUE(all.equal(e2,0)))
+            if (isTRUE(all.equal(e2, 1, check.attributes = FALSE))) return(e1)
+            if (isTRUE(all.equal(e2, 0, check.attributes = FALSE)))
                return(new("Dirac", location = 0))
 
             rnew <- function(n, ...){}