[Distr-commits] r416 - in branches/distr-2.1/pkg: distrEx/R distrEx/chm distrEx/man distrEx/src distrMod/R

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Thu Mar 19 00:25:32 CET 2009


Author: ruckdeschel
Date: 2009-03-19 00:25:32 +0100 (Thu, 19 Mar 2009)
New Revision: 416

Modified:
   branches/distr-2.1/pkg/distrEx/R/Expectation.R
   branches/distr-2.1/pkg/distrEx/R/Expectation_LebDec.R
   branches/distr-2.1/pkg/distrEx/R/Functionals.R
   branches/distr-2.1/pkg/distrEx/R/distrExOptions.R
   branches/distr-2.1/pkg/distrEx/chm/00Index.html
   branches/distr-2.1/pkg/distrEx/chm/E.html
   branches/distr-2.1/pkg/distrEx/chm/Var.html
   branches/distr-2.1/pkg/distrEx/chm/distrEx.chm
   branches/distr-2.1/pkg/distrEx/chm/distrEx.toc
   branches/distr-2.1/pkg/distrEx/chm/distrExOptions.html
   branches/distr-2.1/pkg/distrEx/man/E.Rd
   branches/distr-2.1/pkg/distrEx/man/Var.Rd
   branches/distr-2.1/pkg/distrEx/man/distrExOptions.Rd
   branches/distr-2.1/pkg/distrEx/src/distrEx.dll
   branches/distr-2.1/pkg/distrMod/R/0distrModUtils.R
Log:
distrEx:
expectation gains explicit arguments to set accuracy locally;
also a mixture of quantile and scale based methods is used to determine a sensible integration range
median and IQR are now defined for UnivariateCondDistribution

Modified: branches/distr-2.1/pkg/distrEx/R/Expectation.R
===================================================================
--- branches/distr-2.1/pkg/distrEx/R/Expectation.R	2009-03-18 21:33:07 UTC (rev 415)
+++ branches/distr-2.1/pkg/distrEx/R/Expectation.R	2009-03-18 23:25:32 UTC (rev 416)
@@ -2,24 +2,38 @@
 setMethod("E", signature(object = "UnivariateDistribution", 
                          fun = "missing", 
                          cond = "missing"),
-    function(object){
-        return(mean(r(object)(.distrExOptions$MCIterations)))
+    function(object, Nsim = getdistrExOption("MCIterations"), ...){
+        return(mean(r(object)(Nsim)))
     })
 setMethod("E", signature(object = "AbscontDistribution", 
                          fun = "missing", 
                          cond = "missing"),
-    function(object){
+    function(object,
+             rel.tol= getdistExOption("ErelativeTolerance"), 
+             lowerTruncQuantile = getdistrExOption("ElowerTruncQuantile"), 
+             upperTruncQuantile = getdistrExOption("EupperTruncQuantile"), 
+             IQR.fac = getdistrOption("IQR.fac"), ...
+             ){
         integrand <- function(x, dfun){ x * dfun(x) }
+        
+        low0 <- q(object)(lowerTruncQuantile, lower.tail = TRUE) 
+        upp0 <- q(object)(upperTruncQuantile, lower.tail = FALSE)
+        m <- median(object); s <- IQR(object)
+        low1 <- m - IQR.fac * s 
+        upp1 <- m + IQR.fac * s
+        low <- max(low0,low1) 
+        upp <- min(upp0,upp1) 
+        
         return(distrExIntegrate(f = integrand, 
-                    lower = q(object)(.distrExOptions$ElowerTruncQuantile),
-                    upper = q(object)(1-.distrExOptions$EupperTruncQuantile), 
-                    rel.tol = .distrExOptions$ErelativeTolerance, 
+                    lower = low,
+                    upper = upp, 
+                    rel.tol = rel.tol, 
                     distr = object, dfun = d(object)))
     })
 setMethod("E", signature(object = "DiscreteDistribution", 
                          fun = "missing", 
                          cond = "missing"),
-    function(object){
+    function(object, ...){
         supp <- support(object)
         dfun <- d(object)
         return(sum(supp * dfun(supp)))
@@ -36,8 +50,8 @@
 setMethod("E", signature(object = "AffLinDistribution", 
                          fun = "missing", 
                          cond = "missing"),
-    function(object){
-             object at a * E(object at X0) + object at b
+    function(object, ...){
+             object at a * E(object at X0, ...) + object at b
     })
 
 setMethod("E", signature(object = "AffLinAbscontDistribution", 
@@ -65,13 +79,13 @@
 setMethod("E", signature(object = "MultivariateDistribution", 
                          fun = "missing", 
                          cond = "missing"),
-    function(object){
-        return(colMeans(r(object)(.distrExOptions$MCIterations)))
+    function(object, Nsim = getdistrExOption("MCIterations"), ...){
+        return(colMeans(r(object)(Nsim)))
     })
 setMethod("E", signature(object = "DiscreteMVDistribution", 
                          fun = "missing", 
                          cond = "missing"),
-    function(object){
+    function(object, ...){
         supp <- support(object)
         integrand <- function(x, dfun){ x * dfun(t(x)) }
         erg <- apply(supp, 1, integrand, dfun = d(object))
@@ -83,16 +97,22 @@
 setMethod("E", signature(object = "UnivariateDistribution", 
                          fun = "function", 
                          cond = "missing"),
-    function(object, fun,  useApply = TRUE, ...){
+    function(object, fun,  useApply = TRUE, Nsim = getdistrExOption("MCIterations"), ...){
         if(useApply)        
-            return(mean(sapply(r(object)(.distrExOptions$MCIterations), fun, ...)))
+            return(mean(sapply(r(object)(Nsim), fun, ...)))
         else
-            return(mean(fun(r(object)(.distrExOptions$MCIterations), ...)))
+            return(mean(fun(r(object)(Nsim), ...)))
     })
+
 setMethod("E", signature(object = "AbscontDistribution", 
                          fun = "function", 
                          cond = "missing"),
-    function(object, fun, useApply = TRUE, ...){
+    function(object, fun, useApply = TRUE, 
+             rel.tol= getdistExOption("ErelativeTolerance"), 
+             lowerTruncQuantile = getdistrExOption("ElowerTruncQuantile"), 
+             upperTruncQuantile = getdistrExOption("EupperTruncQuantile"), 
+             IQR.fac = getdistrOption("IQR.fac"), ...){
+
         if(useApply){
             integrand <- function(x, dfun, fun, ...){ 
                 sapply(x, fun, ...) * dfun(x) 
@@ -102,12 +122,22 @@
                 fun(x, ...) * dfun(x) 
             }
         }
-        return(distrExIntegrate(f = integrand, 
-                    lower = q(object)(.distrExOptions$ElowerTruncQuantile), 
-                    upper = q(object)(1-.distrExOptions$EupperTruncQuantile), 
-                    rel.tol = .distrExOptions$ErelativeTolerance, 
+
+        low0 <- q(object)(lowerTruncQuantile, lower.tail = TRUE) 
+        upp0 <- q(object)(upperTruncQuantile, lower.tail = FALSE)
+        m <- median(object); s <- IQR(object)
+        low1 <- m - IQR.fac * s 
+        upp1 <- m + IQR.fac * s
+        low <- max(low0,low1) 
+        upp <- min(upp0,upp1) 
+        
+        return(distrExIntegrate(f = integrand,
+                    lower = low,
+                    upper = upp, 
+                    rel.tol = rel.tol, 
                     distr = object, fun = fun, dfun = d(object), ...))
     })
+
 setMethod("E", signature(object = "DiscreteDistribution", 
                          fun = "function", 
                          cond = "missing"),
@@ -134,8 +164,9 @@
 setMethod("E", signature(object = "MultivariateDistribution", 
                          fun = "function", 
                          cond = "missing"),
-    function(object, fun, useApply = TRUE, ...){
-        x <- r(object)(.distrExOptions$MCIterations)
+    function(object, fun, useApply = TRUE, Nsim = getdistrExOption("MCIterations"), 
+             ...){
+        x <- r(object)(Nsim)
         if(useApply)
             erg <- apply(x, 1, fun, ...)
         else
@@ -171,13 +202,18 @@
 setMethod("E", signature(object = "UnivariateCondDistribution", 
                          fun = "missing", 
                          cond = "numeric"),
-    function(object, cond){
-        return(mean(r(object)(.distrExOptions$MCIterations, cond)))
+    function(object, cond, Nsim = getdistrExOption("MCIterations"), ...){
+        return(mean(r(object)(Nsim, cond)))
     })
 setMethod("E", signature(object = "AbscontCondDistribution", 
                          fun = "missing", 
                          cond = "numeric"),
-    function(object, cond, useApply = TRUE){
+    function(object, cond, useApply = TRUE,
+             rel.tol= getdistExOption("ErelativeTolerance"), 
+             lowerTruncQuantile = getdistrExOption("ElowerTruncQuantile"), 
+             upperTruncQuantile = getdistrExOption("EupperTruncQuantile"), 
+             IQR.fac = getdistrOption("IQR.fac"), ...
+             ){
         fct <- function(x, dfun, cond){ x * dfun(x, cond) }
         if(useApply){
             integrand <- function(x, dfun, cond){ 
@@ -186,16 +222,23 @@
         }else{
             integrand <- fct
         }
+
+        low0 <- q(object)(lowerTruncQuantile, cond = cond, lower.tail = TRUE) 
+        upp0 <- q(object)(upperTruncQuantile, cond = cond, lower.tail = FALSE)
+        m <- median(object, cond = cond); s <- IQR(object, cond = cond)
+        low1 <- m - IQR.fac * s 
+        upp1 <- m + IQR.fac * s
+        low <- max(low0,low1) 
+        upp <- min(upp0,upp1) 
+
         return(distrExIntegrate(integrand, 
-               lower = q(object)(.distrExOptions$ElowerTruncQuantile, cond), 
-                upper = q(object)(1-.distrExOptions$EupperTruncQuantile, cond), 
-                rel.tol = .distrExOptions$ErelativeTolerance, distr = object, 
-                dfun = d(object), cond = cond))
+              lower = low, upper = upp, rel.tol = rel.tol, distr = object, 
+              dfun = d(object), cond = cond))
     })
 setMethod("E", signature(object = "DiscreteCondDistribution", 
                          fun = "missing",
                          cond = "numeric"),
-    function(object,  cond, useApply = TRUE){
+    function(object,  cond, useApply = TRUE, ...){
         supp <- support(object)(cond)
         fct <- function(x, dfun, cond){ x * dfun(x, cond) }
         if(useApply)
@@ -206,21 +249,18 @@
 setMethod("E", signature(object = "UnivariateCondDistribution",
                          fun = "function", 
                          cond = "numeric"),
-    function(object, fun, cond, withCond = FALSE, useApply = TRUE, ...){
+    function(object, fun, cond, withCond = FALSE, useApply = TRUE, 
+             Nsim = getdistrExOption("MCIterations"), ...){
         if(withCond){
             if(useApply)
-                res <- mean(sapply(r(object)(.distrExOptions$MCIterations, 
-                                              cond), fun, cond, ...))
+                res <- mean(sapply(r(object)(Nsim, cond), fun, cond, ...))
             else
-                res <- mean(fun(r(object)(.distrExOptions$MCIterations, 
-                                           cond), ...))
+                res <- mean(fun(r(object)(Nsim, cond), ...))
         }else{
             if(useApply)
-                res <- mean(sapply(r(object)(.distrExOptions$MCIterations, 
-                                              cond), fun, ...))
+                res <- mean(sapply(r(object)(Nsim, cond), fun, ...))
             else
-                res <- mean(fun(r(object)(.distrExOptions$MCIterations, 
-                                           cond), cond, ...))                
+                res <- mean(fun(r(object)(Nsim, cond), cond, ...))                
         }
 
         return(res)
@@ -228,7 +268,12 @@
 setMethod("E", signature(object = "AbscontCondDistribution", 
                          fun = "function", 
                          cond = "numeric"),
-    function(object, fun, cond, withCond = FALSE, useApply = TRUE, ...){
+    function(object, fun, cond, withCond = FALSE, useApply = TRUE,
+             rel.tol= getdistExOption("ErelativeTolerance"), 
+             lowerTruncQuantile = getdistrExOption("ElowerTruncQuantile"), 
+             upperTruncQuantile = getdistrExOption("EupperTruncQuantile"), 
+             IQR.fac = getdistrOption("IQR.fac")
+             , ...){
         if(withCond)
             if(useApply){
                 integrand <- function(x, dfun, fun, cond, ...){ 
@@ -249,11 +294,17 @@
                     fun(x, ...) * dfun(x, cond) 
                 }
             }
+
+        low0 <- q(object)(lowerTruncQuantile, cond = cond, lower.tail = TRUE) 
+        upp0 <- q(object)(1-upperTruncQuantile, cond = cond, lower.tail = FALSE)
+        m <- median(object, cond = cond); s <- IQR(object, cond = cond)
+        low1 <- m - IQR.fac * s 
+        upp1 <- m + IQR.fac * s
+        low <- max(low0,low1) 
+        upp <- min(upp0,upp1) 
         
         return(distrExIntegrate(integrand, 
-                lower = q(object)(.distrExOptions$ElowerTruncQuantile, cond), 
-                upper = q(object)(1-.distrExOptions$EupperTruncQuantile, cond), 
-                rel.tol = .distrExOptions$ErelativeTolerance, distr = object, 
+                lower = low, upper = upp, rel.tol = rel.tol, distr = object, 
                 dfun = d(object), fun = fun, cond = cond, ...))
     })
 setMethod("E", signature(object = "DiscreteCondDistribution", 
@@ -292,14 +343,14 @@
 setMethod("E", signature(object = "Norm", 
                          fun = "missing", 
                          cond = "missing"),
-    function(object){
+    function(object,...){
         return(mean(object))
     })
 
 setMethod("E", signature(object = "Beta", 
                          fun = "missing", 
                          cond = "missing"),
-    function(object){
+    function(object,...){
         if(!isTRUE(all.equal(ncp(object),0)))
           return(E(as(object,"AbscontDistribution"),...))
         else
@@ -309,28 +360,28 @@
 setMethod("E", signature(object = "Binom", 
                          fun = "missing", 
                          cond = "missing"),
-    function(object){
+    function(object, ...){
         return(size(object)*prob(object))
     })
 
 setMethod("E", signature(object = "Cauchy", 
                          fun = "missing", 
                          cond = "missing"),
-    function(object){
+    function(object, ...){
         return(NA)
     })
 
 setMethod("E", signature(object = "Chisq", 
                          fun = "missing", 
                          cond = "missing"),
-    function(object){
+    function(object, ...){
         return(df(object)+ncp(object))
     })
 
 setMethod("E", signature(object = "Dirac", 
                          fun = "missing", 
                          cond = "missing"),
-    function(object){
+    function(object, ...){
         return(location(object))
     })
 
@@ -338,14 +389,14 @@
 setMethod("E", signature(object = "DExp", 
                          fun = "missing", 
                          cond = "missing"),
-    function(object){
+    function(object, ...){
         return(0)
     })
 
 setMethod("E", signature(object = "Exp", 
                          fun = "missing", 
                          cond = "missing"),
-    function(object){
+    function(object, ...){
         return(1/rate(object))
     })
 
@@ -353,7 +404,7 @@
 setMethod("E", signature(object = "Fd", 
                          fun = "missing", 
                          cond = "missing"),
-    function(object){ 
+    function(object, ...){ 
         df1 <- df1(object)
         df2 <- df2(object)
         d <- ncp(object)
@@ -363,56 +414,56 @@
 setMethod("E", signature(object = "Gammad", 
                          fun = "missing", 
                          cond = "missing"),
-    function(object){
+    function(object, ...){
         return(shape(object)*scale(object))
     })
 
 setMethod("E", signature(object = "Geom", 
                          fun = "missing", 
                          cond = "missing"),
-    function(object){
+    function(object, ...){
         return(1/ prob(object) -1)
     })
 
 setMethod("E", signature(object = "Hyper", 
                          fun = "missing", 
                          cond = "missing"),
-    function(object){
+    function(object, ...){
         return(k(object)*m(object)/(m(object)+n(object)))
     })
 
 setMethod("E", signature(object = "Logis", 
                          fun = "missing", 
                          cond = "missing"),
-    function(object){
+    function(object, ...){
         return(location(object))
     })
 
 setMethod("E", signature(object = "Lnorm", 
                          fun = "missing", 
                          cond = "missing"),
-    function(object){
+    function(object, ...){
         return(exp(meanlog(object)+sdlog(object)^2/2))
     })
 
 setMethod("E", signature(object = "Nbinom", 
                          fun = "missing", 
                          cond = "missing"),
-    function(object){
+    function(object, ...){
         return(size(object)*(1-prob(object))/prob(object))
     })
 
 setMethod("E", signature(object = "Pois", 
                          fun = "missing", 
                          cond = "missing"),
-    function(object){
+    function(object, ...){
         return(lambda(object))
     })
 
 setMethod("E", signature(object = "Td", 
                          fun = "missing", 
                          cond = "missing"),
-    function(object){
+    function(object, ...){
         ## correction thanks to G.Jay Kerns
         return(ifelse( df(object)>1, 
                        ncp(object)*sqrt(df(object)/2)*
@@ -423,27 +474,27 @@
 setMethod("E", signature(object = "Unif", 
                          fun = "missing", 
                          cond = "missing"),
-    function(object){
+    function(object, ...){
         return((Max(object)+Min(object))/2)
     })
 
 setMethod("E", signature(object = "Weibull", 
                          fun = "missing", 
                          cond = "missing"),
-    function(object){
+    function(object, ...){
         return(scale(object)*gamma(1+1/shape(object)))
     })
 setMethod("E", signature(object = "Arcsine", 
                          fun = "missing", 
                          cond = "missing"),
-    function(object){
+    function(object, ...){
         return(0)
     })
 
 setMethod("E", signature(object = "Pareto", 
                          fun = "missing", 
                          cond = "missing"),
-    function(object){a <- shape(object); b <- Min(object)
+    function(object, ...){a <- shape(object); b <- Min(object)
         if(a<=1) return(Inf)
         else return(b*a/(a-1))
     })

Modified: branches/distr-2.1/pkg/distrEx/R/Expectation_LebDec.R
===================================================================
--- branches/distr-2.1/pkg/distrEx/R/Expectation_LebDec.R	2009-03-18 21:33:07 UTC (rev 415)
+++ branches/distr-2.1/pkg/distrEx/R/Expectation_LebDec.R	2009-03-18 23:25:32 UTC (rev 416)
@@ -3,24 +3,42 @@
 setMethod("E", signature(object = "UnivarLebDecDistribution",
                          fun = "missing",
                          cond = "missing"),
-    function(object){
-        I.ac <- E(acPart(object))
+    function(object, rel.tol= getdistExOption("ErelativeTolerance"), 
+             lowerTruncQuantile = getdistrExOption("ElowerTruncQuantile"), 
+             upperTruncQuantile = getdistrExOption("EupperTruncQuantile"), 
+             IQR.fac = getdistrOption("IQR.fac"), ...){
+        I.ac <- E(acPart(object), rel.tol = rel.tol, 
+                  lowerTruncQuantile = lowerTruncQuantile,
+                  upperTruncQuantile = upperTruncQuantile,
+                  IQR.fac = IQR.fac, ... )
         I.dc <- E(discretePart(object))
         as.vector(object at mixCoeff %*% c(I.ac, I.dc))
     })
 setMethod("E", signature(object = "UnivarLebDecDistribution",
                          fun = "function",
                          cond = "missing"),
-    function(object, fun, ... ){
-        I.ac <- E(acPart(object), fun = fun, ... )
-        I.dc <- E(discretePart(object), fun = fun, ... )
+    function(object, fun, useApply = TRUE, rel.tol= getdistExOption("ErelativeTolerance"), 
+             lowerTruncQuantile = getdistrExOption("ElowerTruncQuantile"), 
+             upperTruncQuantile = getdistrExOption("EupperTruncQuantile"), 
+             IQR.fac = getdistrOption("IQR.fac"), ... ){
+        I.ac <- E(acPart(object), fun = fun, useApply = useApply, rel.tol = rel.tol, 
+                  lowerTruncQuantile = lowerTruncQuantile,
+                  upperTruncQuantile = upperTruncQuantile,
+                  IQR.fac = IQR.fac, ... )
+        I.dc <- E(discretePart(object), fun = fun, useApply = useApply, ... )
         as.vector(object at mixCoeff %*% c(I.ac, I.dc))
     })
 setMethod("E", signature(object = "UnivarLebDecDistribution",
                          fun = "missing",
                          cond = "ANY"),
-    function(object, cond, ... ){
-        I.ac <- E(acPart(object), cond = cond, ... )
+    function(object, cond, rel.tol= getdistExOption("ErelativeTolerance"), 
+             lowerTruncQuantile = getdistrExOption("ElowerTruncQuantile"), 
+             upperTruncQuantile = getdistrExOption("EupperTruncQuantile"), 
+             IQR.fac = getdistrOption("IQR.fac"), ... ){
+        I.ac <- E(acPart(object), cond = cond, rel.tol = rel.tol, 
+                  lowerTruncQuantile = lowerTruncQuantile,
+                  upperTruncQuantile = upperTruncQuantile,
+                  IQR.fac = IQR.fac, ... )
         I.dc <- E(discretePart(object), cond = cond, ... )
         as.vector(object at mixCoeff %*% c(I.ac, I.dc))
     })
@@ -28,9 +46,17 @@
 setMethod("E", signature(object = "UnivarLebDecDistribution",
                          fun = "function",
                          cond = "ANY"),
-    function(object, fun, cond, ... ){
-        I.ac <- E(acPart(object), fun = fun, cond = cond, ... )
-        I.dc <- E(discretePart(object), fun = fun, cond = cond, ... )
+    function(object, fun, cond, useApply = TRUE, rel.tol= getdistExOption("ErelativeTolerance"), 
+             lowerTruncQuantile = getdistrExOption("ElowerTruncQuantile"), 
+             upperTruncQuantile = getdistrExOption("EupperTruncQuantile"), 
+             IQR.fac = getdistrOption("IQR.fac"), ... ){
+        I.ac <- E(acPart(object), fun = fun, cond = cond, useApply = useApply, 
+                  rel.tol = rel.tol, 
+                  lowerTruncQuantile = lowerTruncQuantile,
+                  upperTruncQuantile = upperTruncQuantile,
+                  IQR.fac = IQR.fac, ... )
+        I.dc <- E(discretePart(object), fun = fun, cond = cond, 
+                  useApply = useApply, ... )
         as.vector(object at mixCoeff %*% c(I.ac, I.dc))
     })
 
@@ -44,9 +70,15 @@
 setMethod("E", signature(object = "AcDcLcDistribution",
                          fun = "ANY",
                          cond = "ANY"),
-    function(object, fun, cond, ... ){
+    function(object, fun, cond, rel.tol= getdistExOption("ErelativeTolerance"), 
+             lowerTruncQuantile = getdistrExOption("ElowerTruncQuantile"), 
+             upperTruncQuantile = getdistrExOption("EupperTruncQuantile"), 
+             IQR.fac = getdistrOption("IQR.fac"), ... ){
         object <- distr:::.ULC.cast(object)
-        I.ac <- E(acPart(object), fun = fun, cond = cond, ... )
+        I.ac <- E(acPart(object), fun = fun, cond = cond, rel.tol = rel.tol, 
+                  lowerTruncQuantile = lowerTruncQuantile,
+                  upperTruncQuantile = upperTruncQuantile,
+                  IQR.fac = IQR.fac, ... )
         I.dc <- E(discretePart(object), fun = fun, cond = cond, ... )
         as.vector(object at mixCoeff %*% c(I.ac, I.dc))
     })
@@ -54,12 +86,12 @@
 setMethod("E", signature(object = "CompoundDistribution",
                          fun = "missing",
                          cond = "missing"),
-    function(object){
+    function(object, ...){
          S <- object at SummandsDistr
          N <- object at NumbOfSummandsDistr
        if(is(S,"UnivariateDistribution"))
-          return(E(S)*E(N))
+          return(E(S, ...)*E(N))
        else{
-          return(E(simplifyD(object)))
+          return(E(simplifyD(object), ...))
        }
     })

Modified: branches/distr-2.1/pkg/distrEx/R/Functionals.R
===================================================================
--- branches/distr-2.1/pkg/distrEx/R/Functionals.R	2009-03-18 21:33:07 UTC (rev 415)
+++ branches/distr-2.1/pkg/distrEx/R/Functionals.R	2009-03-18 23:25:32 UTC (rev 416)
@@ -52,9 +52,9 @@
        S <- x at SummandsDistr
        N <- x at NumbOfSummandsDistr
        if(is(S,"UnivariateDistribution")){
-         return(E(N)*var(S)+ (var(S)+E(S)^2)*var(N))
+         return(E(N)*var(S, ...)+ (var(S, ...)+E(S, ...)^2)*var(N))
        }
-       else  return(var(simplifyD(x)))
+       else  return(var(simplifyD(x),...))
     }})
 
 
@@ -105,6 +105,11 @@
         return(q(x)(1/2))
     })
 
+setMethod("median", signature(x = "UnivariateCondDistribution"),
+    function(x, cond){
+        return(q(x)(1/2, cond = cond))
+    })
+
 setMethod("median", signature(x = "AffLinDistribution"),
     function(x) x at a * median(x at X0) + x at b) 
 
@@ -137,6 +142,11 @@
         return(q(x)(3/4)-q(x)(1/4))
     })
 
+setMethod("IQR", signature(x = "UnivariateCondDistribution"),
+    function(x, cond){
+        return(q(x)(3/4, cond = cond)-q(x)(1/4, cond = cond))
+    })
+
 setMethod("IQR", signature(x = "DiscreteDistribution"),
     function(x) q.r(x)(3/4)-q(x)(1/4)
 )

Modified: branches/distr-2.1/pkg/distrEx/R/distrExOptions.R
===================================================================
--- branches/distr-2.1/pkg/distrEx/R/distrExOptions.R	2009-03-18 21:33:07 UTC (rev 415)
+++ branches/distr-2.1/pkg/distrEx/R/distrExOptions.R	2009-03-18 23:25:32 UTC (rev 416)
@@ -10,7 +10,8 @@
     m2dfLowerTruncQuantile = 0,
     m2dfRelativeTolerance = .Machine$double.eps^0.25,
     nDiscretize = 100,
-    hSmooth = 0.05
+    hSmooth = 0.05,
+    IQR.fac = 15
 )
 
 distrExOptions <- function(...) {

Modified: branches/distr-2.1/pkg/distrEx/chm/00Index.html
===================================================================
--- branches/distr-2.1/pkg/distrEx/chm/00Index.html	2009-03-18 21:33:07 UTC (rev 415)
+++ branches/distr-2.1/pkg/distrEx/chm/00Index.html	2009-03-18 23:25:32 UTC (rev 416)
@@ -383,10 +383,14 @@
 <td>Generic Functions for the Computation of Functionals</td></tr>
 <tr><td width="25%"><a href="Var.html">IQR,Unif-method</a></td>
 <td>Generic Functions for the Computation of Functionals</td></tr>
+<tr><td width="25%"><a href="Var.html">IQR,UnivariateCondDistribution-method</a></td>
+<td>Generic Functions for the Computation of Functionals</td></tr>
 <tr><td width="25%"><a href="Var.html">IQR,UnivariateDistribution-method</a></td>
 <td>Generic Functions for the Computation of Functionals</td></tr>
 <tr><td width="25%"><a href="Var.html">IQR-methods</a></td>
 <td>Generic Functions for the Computation of Functionals</td></tr>
+<tr><td width="25%"><a href="distrExOptions.html">IQR.fac</a></td>
+<td>Function to change the global variables of the package 'distrEx'</td></tr>
 </table>
 
 <h2><a name="K">-- K --</a></h2>
@@ -634,6 +638,8 @@
 <td>Generic Functions for the Computation of Functionals</td></tr>
 <tr><td width="25%"><a href="Var.html">median,Unif-method</a></td>
 <td>Generic Functions for the Computation of Functionals</td></tr>
+<tr><td width="25%"><a href="Var.html">median,UnivariateCondDistribution-method</a></td>
+<td>Generic Functions for the Computation of Functionals</td></tr>
 <tr><td width="25%"><a href="Var.html">median,UnivariateDistribution-method</a></td>
 <td>Generic Functions for the Computation of Functionals</td></tr>
 <tr><td width="25%"><a href="Var.html">median-methods</a></td>

Modified: branches/distr-2.1/pkg/distrEx/chm/E.html
===================================================================
--- branches/distr-2.1/pkg/distrEx/chm/E.html	2009-03-18 21:33:07 UTC (rev 415)
+++ branches/distr-2.1/pkg/distrEx/chm/E.html	2009-03-18 23:25:32 UTC (rev 416)
@@ -77,12 +77,20 @@
 E(object, fun, cond, ...)
 
 ## S4 method for signature 'UnivariateDistribution,
+##   missing, missing':
+E(object, Nsim = getdistrExOption("MCIterations"), ...)
+
+## S4 method for signature 'UnivariateDistribution,
 ##   function, missing':
-E(object, fun, useApply = TRUE, ...)
+E(object, fun, useApply = TRUE, Nsim = getdistrExOption("MCIterations"), ...)
 
 ## S4 method for signature 'AbscontDistribution, function,
 ##   missing':
-E(object, fun,  useApply = TRUE, ...)
+E(object, fun,  useApply = TRUE,
+             rel.tol= getdistExOption("ErelativeTolerance"), 
+             lowerTruncQuantile = getdistrExOption("ElowerTruncQuantile"), 
+             upperTruncQuantile = getdistrExOption("EupperTruncQuantile"), 
+             IQR.fac = getdistrOption("IQR.fac"), ...)
 
 ## S4 method for signature 'DiscreteDistribution, function,
 ##   missing':
@@ -90,15 +98,19 @@
 
 ## S4 method for signature 'AffLinDistribution, missing,
 ##   missing':
-E(object)
+E(object,...)
 
 ## S4 method for signature 'AffLinUnivarLebDecDistribution,
 ##   missing, missing':
-E(object)
+E(object,...)
 
 ## S4 method for signature 'MultivariateDistribution,
+##   missing, missing':
+E(object, Nsim = getdistrExOption("MCIterations"), ...)
+## S4 method for signature 'MultivariateDistribution,
 ##   function, missing':
-E(object, fun, useApply = TRUE, ...)
+E(object, fun, useApply = TRUE, 
+              Nsim = getdistrExOption("MCIterations"), ...)
 
 ## S4 method for signature 'DiscreteMVDistribution,
 ##   function, missing':
@@ -106,7 +118,11 @@
 
 ## S4 method for signature 'AbscontCondDistribution,
 ##   missing, numeric':
-E(object, cond, useApply = TRUE)
+E(object, cond, useApply = TRUE,
+             rel.tol= getdistExOption("ErelativeTolerance"), 
+             lowerTruncQuantile = getdistrExOption("ElowerTruncQuantile"), 
+             upperTruncQuantile = getdistrExOption("EupperTruncQuantile"), 
+             IQR.fac = getdistrOption("IQR.fac"), ...)
 
 ## S4 method for signature 'DiscreteCondDistribution,
 ##   missing, numeric':
@@ -114,66 +130,109 @@
 
 ## S4 method for signature 'UnivariateCondDistribution,
 ##   function, numeric':
-E(object, fun, cond, withCond = FALSE, useApply = TRUE, ...)
+E(object, fun, cond, 
+              withCond = FALSE, useApply = TRUE, 
+              Nsim = getdistrExOption("MCIterations"), ...)
 
 ## S4 method for signature 'AbscontCondDistribution,
 ##   function, numeric':
-E(object, fun, cond, withCond = FALSE, useApply = TRUE, ...)
+E(object, fun, cond, 
+               withCond = FALSE, useApply = TRUE,
+             rel.tol= getdistExOption("ErelativeTolerance"), 
+             lowerTruncQuantile = getdistrExOption("ElowerTruncQuantile"), 
+             upperTruncQuantile = getdistrExOption("EupperTruncQuantile"), 
+             IQR.fac = getdistrOption("IQR.fac")
+             , ...)
 
 ## S4 method for signature 'DiscreteCondDistribution,
 ##   function, numeric':
-E(object, fun, cond, withCond = FALSE, useApply = TRUE, ...)
+E(object, fun, cond, 
+             withCond = FALSE, useApply = TRUE, ...)
 
 ## S4 method for signature 'DiscreteCondDistribution,
 ##   function, numeric':
-E(object, fun, cond, withCond = FALSE, useApply = TRUE, ...)
+E(object, fun, cond, 
+             withCond = FALSE, useApply = TRUE, ...)
+             
+## S4 method for signature 'UnivarLebDecDistribution,
+##   missing, missing':
+E(object,  
+             rel.tol= getdistExOption("ErelativeTolerance"), 
+             lowerTruncQuantile = getdistrExOption("ElowerTruncQuantile"), 
+             upperTruncQuantile = getdistrExOption("EupperTruncQuantile"), 
+             IQR.fac = getdistrOption("IQR.fac"), ... )
+## S4 method for signature 'UnivarLebDecDistribution,
+##   function, missing':
+E(object, fun, 
+             useApply = TRUE, rel.tol= getdistExOption("ErelativeTolerance"), 
+             lowerTruncQuantile = getdistrExOption("ElowerTruncQuantile"), 
+             upperTruncQuantile = getdistrExOption("EupperTruncQuantile"), 
+             IQR.fac = getdistrOption("IQR.fac"), ... )
+## S4 method for signature 'UnivarLebDecDistribution,
+##   missing, ANY':
+E(object, cond, 
+             rel.tol= getdistExOption("ErelativeTolerance"), 
+             lowerTruncQuantile = getdistrExOption("ElowerTruncQuantile"), 
+             upperTruncQuantile = getdistrExOption("EupperTruncQuantile"), 
+             IQR.fac = getdistrOption("IQR.fac"), ... )
+## S4 method for signature 'UnivarLebDecDistribution,
+##   function, ANY':
+E(object, fun, cond, 
+             useApply = TRUE, rel.tol= getdistExOption("ErelativeTolerance"), 
+             lowerTruncQuantile = getdistrExOption("ElowerTruncQuantile"), 
+             upperTruncQuantile = getdistrExOption("EupperTruncQuantile"), 
+             IQR.fac = getdistrOption("IQR.fac"), ... )
 
 ## S4 method for signature 'AcDcLcDistribution, ANY, ANY':
-E(object, fun, cond, ... )
+E(object, fun, cond, 
+             rel.tol= getdistExOption("ErelativeTolerance"), 
+             lowerTruncQuantile = getdistrExOption("ElowerTruncQuantile"), 
+             upperTruncQuantile = getdistrExOption("EupperTruncQuantile"), 
+             IQR.fac = getdistrOption("IQR.fac"), ... )
 ## S4 method for signature 'CompoundDistribution, missing,
 ##   missing':
-E(object)
+E(object, ...)
 
 ## S4 method for signature 'Beta, missing, missing':
-E(object)
+E(object, ...)
 ## S4 method for signature 'Binom, missing, missing':
-E(object)
+E(object, ...)
 ## S4 method for signature 'Cauchy, missing, missing':
-E(object)
+E(object, ...)
 ## S4 method for signature 'Chisq, missing, missing':
-E(object)
+E(object, ...)
 ## S4 method for signature 'Dirac, missing, missing':
-E(object)
+E(object, ...)
 ## S4 method for signature 'DExp, missing, missing':
-E(object)
+E(object, ...)
 ## S4 method for signature 'Exp, missing, missing':
-E(object)
+E(object, ...)
 ## S4 method for signature 'Fd, missing, missing':
-E(object)
+E(object, ...)
 ## S4 method for signature 'Gammad, missing, missing':
-E(object)
+E(object, ...)
 ## S4 method for signature 'Geom, missing, missing':
-E(object)
+E(object, ...)
 ## S4 method for signature 'Hyper, missing, missing':
-E(object)
+E(object, ...)
 ## S4 method for signature 'Logis, missing, missing':
-E(object)
+E(object, ...)
 ## S4 method for signature 'Lnorm, missing, missing':
-E(object)
+E(object, ...)
 ## S4 method for signature 'Nbinom, missing, missing':
-E(object)
+E(object, ...)
 ## S4 method for signature 'Norm, missing, missing':
-E(object)
+E(object, ...)
 ## S4 method for signature 'Pois, missing, missing':
-E(object)
+E(object, ...)
 ## S4 method for signature 'Unif, missing, missing':
-E(object)
+E(object, ...)
 ## S4 method for signature 'Td, missing, missing':
-E(object)
+E(object, ...)
 ## S4 method for signature 'Weibull, missing, missing':
-E(object)
+E(object, ...)
 ## S4 method for signature 'Arcsine, missing, missing':
-E(object)
+E(object, ...)
 ## S4 method for signature 'Pareto, missing, missing':
[TRUNCATED]

To get the complete diff run:
    svnlook diff /svnroot/distr -r 416


More information about the Distr-commits mailing list