[Distr-commits] r713 - branches/distr-2.4/pkg/distrEx/R branches/distr-2.4/pkg/distrEx/src pkg/distrEx/R

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

Author: ruckdeschel
Date: 2011-01-06 23:54:09 +0100 (Thu, 06 Jan 2011)
New Revision: 713

Modified:
   branches/distr-2.4/pkg/distrEx/R/Functionals.R
   branches/distr-2.4/pkg/distrEx/src/distrEx.dll
   pkg/distrEx/R/Functionals.R
Log:
corrected bug in var() (with argument fun in case of symmetry)

Modified: branches/distr-2.4/pkg/distrEx/R/Functionals.R
===================================================================
--- branches/distr-2.4/pkg/distrEx/R/Functionals.R	2011-01-05 16:50:10 UTC (rev 712)
+++ branches/distr-2.4/pkg/distrEx/R/Functionals.R	2011-01-06 22:54:09 UTC (rev 713)
@@ -16,7 +16,7 @@
         ztr <- 0
         if(is(Symmetry(x),"SphericalSymmetry")){ 
              ztr <- SymmCenter(Symmetry(x))
-             x <- x-ztr
+             x0 <- x-ztr
         }
         
         LowIsUpp <- if(low == -Inf) 
@@ -24,7 +24,7 @@
         
         if(LowIsUpp && missing(cond)&&missing(fun)){
            if(is(Symmetry(x),"SphericalSymmetry"))
-              return(2 * E(x, fun = function(t)t^2, low =0, useApply = useApply, ...))
+              return(2 * E(x0, fun = function(t)t^2, low =0, useApply = useApply, ...))
         }
 
         f2 <- function(t) {fun(t)^2}

Modified: branches/distr-2.4/pkg/distrEx/src/distrEx.dll
===================================================================
(Binary files differ)

Modified: pkg/distrEx/R/Functionals.R
===================================================================
--- pkg/distrEx/R/Functionals.R	2011-01-05 16:50:10 UTC (rev 712)
+++ pkg/distrEx/R/Functionals.R	2011-01-06 22:54:09 UTC (rev 713)
@@ -8,17 +8,15 @@
 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
+             x0 <- x-ztr
         }
         
         LowIsUpp <- if(low == -Inf) 
@@ -26,7 +24,7 @@
         
         if(LowIsUpp && missing(cond)&&missing(fun)){
            if(is(Symmetry(x),"SphericalSymmetry"))
-              return(2 * E(x, fun = function(t)t^2, low =0, useApply = useApply, ...))
+              return(2 * E(x0, fun = function(t)t^2, low =0, useApply = useApply, ...))
         }
 
         f2 <- function(t) {fun(t)^2}
@@ -42,7 +40,6 @@
             m2 <- E(x, cond = cond, fun = f2, withCond  = withCond, useApply = 
                     useApply, ...)
             }
-#        print(c(m2,m^2))
         return(m2-m^2)
     })