[Distr-commits] r656 - branches/distr-2.3/pkg/distrEx/R pkg/distrEx/R

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

Author: ruckdeschel
Date: 2010-05-19 02:31:55 +0200 (Wed, 19 May 2010)
New Revision: 656

Modified:
   branches/distr-2.3/pkg/distrEx/R/Functionals.R
   pkg/distrEx/R/Functionals.R
Log:
distrEx: found a bug in setMethod("var", signature(x = "UnivariateDistribution") for spherical symmetric distributions

Modified: branches/distr-2.3/pkg/distrEx/R/Functionals.R
===================================================================
--- branches/distr-2.3/pkg/distrEx/R/Functionals.R	2010-05-16 23:42:46 UTC (rev 655)
+++ branches/distr-2.3/pkg/distrEx/R/Functionals.R	2010-05-19 00:31:55 UTC (rev 656)
@@ -13,13 +13,20 @@
         low <- -Inf; upp <- Inf
         if(hasArg(low)) low <- dots$low
         if(hasArg(upp)) upp <- dots$upp
+        ztr <- 0
+        if(is(Symmetry(x),"SphericalSymmetry")){ 
+             ztr <- SymmCenter(Symmetry(x))
+             x <- x-ztr
+        }
+        
         LowIsUpp <- if(low == -Inf) 
-                    low == -upp else distr:::.isEqual(low,upp)
+                    low == -upp else distr:::.isEqual(ztr-low,upp-ztr)
         
         if(LowIsUpp && missing(cond)&&missing(fun)){
            if(is(Symmetry(x),"SphericalSymmetry"))
               return(2 * E(x, fun = function(t)t^2, low =0, useApply = useApply, ...))
         }
+
         f2 <- function(t) {fun(t)^2}
         
         if(missing(cond))

Modified: pkg/distrEx/R/Functionals.R
===================================================================
--- pkg/distrEx/R/Functionals.R	2010-05-16 23:42:46 UTC (rev 655)
+++ pkg/distrEx/R/Functionals.R	2010-05-19 00:31:55 UTC (rev 656)
@@ -8,13 +8,21 @@
 setMethod("var", signature(x = "UnivariateDistribution"),
     function(x, fun = function(t) {t}, cond, withCond = FALSE, useApply = TRUE, 
              ...){
+
         if(missing(useApply)) useApply <- TRUE
         dots <- list(...)
         low <- -Inf; upp <- Inf
         if(hasArg(low)) low <- dots$low
         if(hasArg(upp)) upp <- dots$upp
+        
+        ztr <- 0
+        if(is(Symmetry(x),"SphericalSymmetry")){ 
+             ztr <- SymmCenter(Symmetry(x))
+             x <- x-ztr
+        }
+        
         LowIsUpp <- if(low == -Inf) 
-                    low == -upp else distr:::.isEqual(low,upp)
+                    low == -upp else distr:::.isEqual(ztr-low,upp-ztr)
         
         if(LowIsUpp && missing(cond)&&missing(fun)){
            if(is(Symmetry(x),"SphericalSymmetry"))
@@ -33,6 +41,7 @@
             m2 <- E(x, cond = cond, fun = f2, withCond  = withCond, useApply = 
                     useApply, ...)
             }
+#        print(c(m2,m^2))
         return(m2-m^2)
     })