[Distr-commits] r469 - in branches/distr-2.2/pkg: distr/R distr/chm distr/inst/doc distrEx/R distrEx/chm distrEx/man

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Thu May 14 15:28:14 CEST 2009


Author: ruckdeschel
Date: 2009-05-14 15:28:14 +0200 (Thu, 14 May 2009)
New Revision: 469

Modified:
   branches/distr-2.2/pkg/distr/R/ContDistribution.R
   branches/distr-2.2/pkg/distr/chm/Distr.chm
   branches/distr-2.2/pkg/distr/inst/doc/Rplots.pdf
   branches/distr-2.2/pkg/distr/inst/doc/newDistributions.pdf
   branches/distr-2.2/pkg/distrEx/R/Expectation.R
   branches/distr-2.2/pkg/distrEx/chm/00Index.html
   branches/distr-2.2/pkg/distrEx/chm/0distrEx-package.html
   branches/distr-2.2/pkg/distrEx/chm/E.html
   branches/distr-2.2/pkg/distrEx/chm/distrEx.chm
   branches/distr-2.2/pkg/distrEx/chm/distrEx.toc
   branches/distr-2.2/pkg/distrEx/man/E.Rd
Log:
new expectation methods for UnivarMixingDistribution

Modified: branches/distr-2.2/pkg/distr/R/ContDistribution.R
===================================================================
--- branches/distr-2.2/pkg/distr/R/ContDistribution.R	2009-05-14 12:17:07 UTC (rev 468)
+++ branches/distr-2.2/pkg/distr/R/ContDistribution.R	2009-05-14 13:28:14 UTC (rev 469)
@@ -430,45 +430,45 @@
 setMethod("abs", "AbscontDistribution",
     function(x){
        if (.isEqual(p(x)(0),0)) return(x)
-       x <- x
+       xx <- x
        rnew <- function(n, ...){}
-       body(rnew) <- substitute({ abs(g(n, ...)) }, list(g = x at r))
+       body(rnew) <- substitute({ abs(g(n, ...)) }, list(g = xx at r))
        
        isSym0 <- FALSE
-       if(is(Symmetry(x),"SphericalSymmetry"))
-          if(.isEqual(SymmCenter(Symmetry(x)),0))
+       if(is(Symmetry(xx),"SphericalSymmetry"))
+          if(.isEqual(SymmCenter(Symmetry(xx)),0))
              isSym0 <- TRUE  
        
        if(isSym0){
-          if (is.null(gaps(x)))
+          if (is.null(gaps(xx)))
               gapsnew <- NULL
           else {gapsnew <- gaps[gaps[,2]>=0,]
                 VZW <- gapsnew[,1] <= 0 
                 gapsnew[VZW,1] <- 0
                 gapsnew <- .consolidategaps(gapsnew)}
-          dOx <- d(x)
+          dOx <- d(xx)
 
           dxlog <- if("log" %in% names(formals(dOx))) 
                         quote({dOx(x, log = TRUE)})
                    else quote({log(dOx(x))})
           pxlog <- if("log.p" %in% names(formals(p(x))) && 
                        "lower.tail" %in% names(formals(p(x)))) 
-                        quote({p(x)(q, lower.tail = FALSE, log.p = TRUE)})
+                        quote({p(xx)(q, lower.tail = FALSE, log.p = TRUE)})
                    else
-                        quote({log(1-p(x)(q))})
+                        quote({log(1-p(xx)(q))})
 
-          qxlog <- if("lower.tail" %in% names(formals(q(x)))) 
+          qxlog <- if("lower.tail" %in% names(formals(q(xx)))) 
                           quote({qx <- if(lower.tail)
-                                          q(x)((1+p1)/2)
+                                          q(xx)((1+p1)/2)
                                        else
-                                          q(x)(p1/2,lower.tail=FALSE)}) 
+                                          q(xx)(p1/2,lower.tail=FALSE)}) 
                       else
-                          quote({qx <- q(x)(if(lower.tail) (1+p1)/2 else 1-p1/2)})
-          if("lower.tail" %in% names(formals(q(x)))&& 
-             "log.p" %in% names(formals(q(x))))           
-              qxlog <- quote({qx <- if(lower.tail) q(x)((1+p1)/2)
+                          quote({qx <- q(xx)(if(lower.tail) (1+p1)/2 else 1-p1/2)})
+          if("lower.tail" %in% names(formals(q(xx)))&& 
+             "log.p" %in% names(formals(q(xx))))           
+              qxlog <- quote({qx <- if(lower.tail) q(xx)((1+p1)/2)
                                        else
-                                          q(x)(if(log.p)p-log(2)
+                                          q(xx)(if(log.p)p-log(2)
                                                else p1/2,lower.tail=FALSE,log.p=log.p)}) 
           dnew <- function(x, log = FALSE){}
           body(dnew) <- substitute({
@@ -501,21 +501,20 @@
             }, list(qxlog0 = qxlog, objN= quote(.getObjName(1))))
                    
        }else{
-            if (is.null(gaps(x)))
+            if (is.null(gaps(xx)))
                 gapsnew <- NULL
-            else {VZW <- gaps(x)[,1] <= 0 & gaps(x)[,2] >= 0
-                  gapsnew <- t(apply(abs(gaps(x)), 1, sort))
-                  gapsnew[VZW,2] <- pmin(-gaps(x)[VZW,1], gaps(x)[VZW,2])
+            else {VZW <- gaps(xx)[,1] <= 0 & gaps(xx)[,2] >= 0
+                  gapsnew <- t(apply(abs(gaps(xx)), 1, sort))
+                  gapsnew[VZW,2] <- pmin(-gaps(xx)[VZW,1], gaps(x)[VZW,2])
                   gapsnew[VZW,1] <- 0
                   gapsnew <- .consolidategaps(gapsnew)}
             
-            lower <- max(0, getLow(x))
-            upper <- max(-getLow(x) , abs(getUp(x)))
+            lower <- max(0, getLow(xx))
+            upper <- max(-getLow(xx) , abs(getUp(xx)))
 
             n <- getdistrOption("DefaultNrFFTGridPointsExponent")
             h <- (upper-lower)/2^n
 
-            xx <- x
             x.g <- seq(from = lower, to = upper, by = h)
 
             dnew <- function(x, log = FALSE){
@@ -527,16 +526,16 @@
                     return(dx)
             }
             
-            pxlow <- if("lower.tail" %in% names(formals(p(x))))
-                        substitute({p(x)(q, lower=FALSE)})
+            pxlow <- if("lower.tail" %in% names(formals(p(xx))))
+                        substitute({p(xx)(q, lower=FALSE)})
                    else
-                        substitute({1-p(x)(q)})
+                        substitute({1-p(xx)(q)})
 
             pnew <- function(q, lower.tail = TRUE, log.p = FALSE){}
             body(pnew) <- substitute({
                     px <- if (lower.tail)
-                            (q>=0) * (p(x)(q) - p(x)(-q))                    
-                          else pxlow0 + p(x)(-q)
+                            (q>=0) * (p(xx)(q) - p(xx)(-q))                    
+                          else pxlow0 + p(xx)(-q)
                     if (log.p) px <- log(px)
                     return(px)
             }, list(pxlow0 = pxlow))
@@ -544,7 +543,7 @@
             px.l <- pnew(x.g + 0.5*h)
             px.u <- pnew(x.g + 0.5*h, lower.tail = FALSE)
             
-            yR <- max(q(x)(1), abs(q(x)(0)))
+            yR <- max(q(xx)(1), abs(q(xx)(0)))
 
             qnew <- .makeQNew(x.g + 0.5*h, px.l, px.u,
                               notwithLLarg = FALSE,  lower, yR)
@@ -553,7 +552,7 @@
  
     }
     object <- AbscontDistribution( r = rnew, p = pnew, q = qnew, d = dnew, 
-                     gaps = gapsnew,  .withSim = x at .withSim, .withArith = TRUE,
+                     gaps = gapsnew,  .withSim = xx at .withSim, .withArith = TRUE,
                      .lowerExact = .lowerExact(x), .logExact = FALSE)
     object
     })

Modified: branches/distr-2.2/pkg/distr/chm/Distr.chm
===================================================================
(Binary files differ)

Modified: branches/distr-2.2/pkg/distr/inst/doc/Rplots.pdf
===================================================================
--- branches/distr-2.2/pkg/distr/inst/doc/Rplots.pdf	2009-05-14 12:17:07 UTC (rev 468)
+++ branches/distr-2.2/pkg/distr/inst/doc/Rplots.pdf	2009-05-14 13:28:14 UTC (rev 469)
@@ -2,10 +2,10 @@
 %âãÏÓ\r
 1 0 obj
 <<
-/CreationDate (D:20090319224335)
-/ModDate (D:20090319224335)
+/CreationDate (D:20090514143051)
+/ModDate (D:20090514143051)
 /Title (R Graphics Output)
-/Producer (R 2.9.0)
+/Producer (R 2.10.0)
 /Creator (R)
 >>
 endobj
@@ -375,18 +375,18 @@
 75.26 162.23 l
 75.36 163.91 l
 75.46 165.60 l
-75.56 167.30 l
+75.56 167.31 l
 75.66 169.03 l
 75.76 170.77 l
 75.86 172.53 l
 75.96 174.31 l
-76.06 176.11 l
+76.06 176.10 l
 76.17 177.92 l
 76.27 179.74 l
 76.37 181.59 l
 76.47 183.45 l
 76.57 185.33 l
-76.67 187.22 l
+76.67 187.23 l
 76.77 189.14 l
 76.87 191.06 l
 76.97 193.01 l
@@ -407,7 +407,7 @@
 78.49 223.93 l
 78.59 226.10 l
 78.69 228.28 l
-78.79 230.48 l
+78.79 230.47 l
 78.90 232.68 l
 79.00 234.90 l
 79.10 237.12 l
@@ -416,7 +416,7 @@
 79.40 243.87 l
 79.50 246.13 l
 79.60 248.41 l
-79.70 250.70 l
+79.70 250.69 l
 79.81 252.99 l
 79.91 255.29 l
 80.01 257.60 l
@@ -431,7 +431,7 @@
 80.92 278.66 l
 81.02 281.02 l
 81.12 283.39 l
-81.22 285.76 l
+81.22 285.75 l
 81.32 288.13 l
 81.42 290.50 l
 81.52 292.87 l
@@ -446,20 +446,20 @@
 82.43 314.20 l
 82.54 316.56 l
 82.64 318.92 l
-82.74 321.26 l
+82.74 321.27 l
 82.84 323.61 l
 82.94 325.95 l
 83.04 328.28 l
 83.14 330.60 l
 83.24 332.92 l
 83.34 335.23 l
-83.44 337.53 l
+83.44 337.52 l
 83.55 339.82 l
 83.65 342.10 l
 83.75 344.37 l
 83.85 346.63 l
 83.95 348.88 l
-84.05 351.11 l
+84.05 351.12 l
 84.15 353.34 l
 84.25 355.55 l
 84.35 357.75 l
@@ -470,7 +470,7 @@
 84.86 368.52 l
 84.96 370.63 l
 85.06 372.71 l
-85.16 374.79 l
+85.16 374.78 l
 85.26 376.84 l
 85.37 378.87 l
 85.47 380.88 l
@@ -485,7 +485,7 @@
 86.38 398.05 l
 86.48 399.85 l
 86.58 401.61 l
-86.68 403.36 l
+86.68 403.35 l
 86.78 405.07 l
 86.88 406.76 l
 86.98 408.42 l
@@ -568,7 +568,7 @@
 94.77 433.16 l
 94.87 432.06 l
 94.97 430.93 l
-95.07 429.76 l
+95.07 429.77 l
 95.17 428.57 l
 95.27 427.34 l
 95.37 426.08 l
@@ -579,7 +579,7 @@
 95.88 419.32 l
 95.98 417.88 l
 96.08 416.41 l
-96.18 414.92 l
+96.18 414.91 l
 96.28 413.39 l
 96.39 411.84 l
 96.49 410.26 l
@@ -593,7 +593,7 @@
 97.30 396.72 l
 97.40 394.92 l
 97.50 393.10 l
-97.60 391.26 l
+97.60 391.25 l
 97.70 389.39 l
 97.80 387.51 l
 97.90 385.60 l
@@ -603,13 +603,13 @@
 98.31 377.79 l
 98.41 375.79 l
 98.51 373.78 l
-98.61 371.75 l
+98.61 371.74 l
 98.71 369.70 l
 98.81 367.63 l
-98.91 365.56 l
+98.91 365.55 l
 99.01 363.46 l
 99.11 361.36 l
-99.22 359.24 l
+99.22 359.23 l
 99.32 357.10 l
 99.42 354.96 l
 99.52 352.80 l
@@ -619,7 +619,7 @@
 99.92 344.06 l
 100.02 341.85 l
 100.13 339.63 l
-100.23 337.41 l
+100.23 337.40 l
 100.33 335.17 l
 100.43 332.93 l
 100.53 330.68 l
@@ -632,8 +632,8 @@
 101.24 314.79 l
 101.34 312.50 l
 101.44 310.22 l
-101.54 307.93 l
-101.64 305.63 l
+101.54 307.92 l
+101.64 305.64 l
 101.74 303.34 l
 101.84 301.05 l
 101.95 298.75 l
@@ -657,7 +657,7 @@
 103.77 257.93 l
 103.87 255.72 l
 103.97 253.51 l
-104.07 251.30 l
+104.07 251.31 l
 104.17 249.11 l
 104.27 246.93 l
 104.37 244.75 l
@@ -682,7 +682,7 @@
 106.29 205.49 l
 106.39 203.55 l
 106.49 201.63 l
-106.60 199.71 l
+106.60 199.72 l
 106.70 197.82 l
 106.80 195.93 l
 106.90 194.07 l
@@ -695,15 +695,15 @@
 107.61 181.41 l
 107.71 179.66 l
 107.81 177.93 l
-107.91 176.22 l
+107.91 176.21 l
 108.01 174.51 l
 108.11 172.83 l
 108.21 171.16 l
 108.31 169.51 l
-108.42 167.88 l
+108.42 167.87 l
 108.52 166.26 l
 108.62 164.65 l
-108.72 163.06 l
+108.72 163.07 l
 108.82 161.49 l
 108.92 159.94 l
 109.02 158.40 l
@@ -733,8 +733,8 @@
 111.45 126.35 l
 111.55 125.21 l
 111.65 124.09 l
-111.75 122.99 l
-111.85 121.89 l
+111.75 122.98 l
+111.85 121.90 l
 111.95 120.82 l
 112.06 119.76 l
 112.16 118.71 l
@@ -861,7 +861,7 @@
 124.39 66.88 l
 124.49 66.80 l
 124.59 66.72 l
-124.69 66.63 l
+124.69 66.64 l
 124.79 66.56 l
 124.89 66.48 l
 125.00 66.40 l
@@ -6837,21 +6837,21 @@
 0 17
 0000000000 65535 f 
 0000000021 00000 n 
-0000000163 00000 n 
-0000111797 00000 n 
-0000111893 00000 n 
-0000000212 00000 n 
-0000000292 00000 n 
-0000051237 00000 n 
-0000051258 00000 n 
-0000051338 00000 n 
-0000061046 00000 n 
-0000061067 00000 n 
-0000061149 00000 n 
-0000111775 00000 n 
-0000111987 00000 n 
-0000112082 00000 n 
-0000112166 00000 n 
+0000000164 00000 n 
+0000111798 00000 n 
+0000111894 00000 n 
+0000000213 00000 n 
+0000000293 00000 n 
+0000051238 00000 n 
+0000051259 00000 n 
+0000051339 00000 n 
+0000061047 00000 n 
+0000061068 00000 n 
+0000061150 00000 n 
+0000111776 00000 n 
+0000111988 00000 n 
+0000112083 00000 n 
+0000112167 00000 n 
 trailer
 <<
 /Size 17
@@ -6859,5 +6859,5 @@
 /Root 2 0 R
 >>
 startxref
-112264
+112265
 %%EOF

Modified: branches/distr-2.2/pkg/distr/inst/doc/newDistributions.pdf
===================================================================
(Binary files differ)

Modified: branches/distr-2.2/pkg/distrEx/R/Expectation.R
===================================================================
--- branches/distr-2.2/pkg/distrEx/R/Expectation.R	2009-05-14 12:17:07 UTC (rev 468)
+++ branches/distr-2.2/pkg/distrEx/R/Expectation.R	2009-05-14 13:28:14 UTC (rev 469)
@@ -869,3 +869,79 @@
           return(E(simplifyD(object), low = low, upp = upp, ...))
        }
     })
+
+setMethod("E", signature(object = "UnivarMixingDistribution",
+                         fun = "missing",
+                         cond = "missing"),
+    function(object, low = NULL, upp = NULL, rel.tol= getdistrExOption("ErelativeTolerance"), 
+             lowerTruncQuantile = getdistrExOption("ElowerTruncQuantile"), 
+             upperTruncQuantile = getdistrExOption("EupperTruncQuantile"), 
+             IQR.fac = getdistrExOption("IQR.fac"), ...){
+        l <- length(object at mixCoeff)
+        Ei <- numeric(l)
+        for(i in 1:l)
+            Ei <- object at mixCoeff[i] * E(object = object at mixDistr[[i]], low = low, 
+                                         upp = upp, rel.tol = rel.tol,
+                                         lowerTruncQuantile = lowerTruncQuantile, 
+                                         upperTruncQuantile = upperTruncQuantile, 
+                                         IQR.fac = IQR.fac, ...)
+        sum(Ei)
+    })
+setMethod("E", signature(object = "UnivarMixingDistribution",
+                         fun = "function",
+                         cond = "missing"),
+    function(object, fun, useApply = TRUE, low = NULL, upp = NULL, 
+             rel.tol= getdistrExOption("ErelativeTolerance"), 
+             lowerTruncQuantile = getdistrExOption("ElowerTruncQuantile"), 
+             upperTruncQuantile = getdistrExOption("EupperTruncQuantile"), 
+             IQR.fac = getdistrExOption("IQR.fac"), ... ){
+        l <- length(object at mixCoeff)
+        Ei <- numeric(l)
+        for(i in 1:l)
+            Ei <- object at mixCoeff[i] * E(object = object at mixDistr[[i]], 
+                                         fun = fun, low = low, 
+                                         upp = upp, rel.tol = rel.tol,
+                                         lowerTruncQuantile = lowerTruncQuantile, 
+                                         upperTruncQuantile = upperTruncQuantile, 
+                                         IQR.fac = IQR.fac, ...)
+        sum(Ei)
+    })
+setMethod("E", signature(object = "UnivarMixingDistribution",
+                         fun = "missing",
+                         cond = "ANY"),
+    function(object, cond, low = NULL, upp = NULL, 
+             rel.tol= getdistrExOption("ErelativeTolerance"), 
+             lowerTruncQuantile = getdistrExOption("ElowerTruncQuantile"), 
+             upperTruncQuantile = getdistrExOption("EupperTruncQuantile"), 
+             IQR.fac = getdistrExOption("IQR.fac"), ... ){
+        l <- length(object at mixCoeff)
+        Ei <- numeric(l)
+        for(i in 1:l)
+            Ei <- object at mixCoeff[i] * E(object = object at mixDistr[[i]], 
+                                         cond = cond, low = low, 
+                                         upp = upp, rel.tol = rel.tol,
+                                         lowerTruncQuantile = lowerTruncQuantile, 
+                                         upperTruncQuantile = upperTruncQuantile, 
+                                         IQR.fac = IQR.fac, ...)
+        sum(Ei)
+    })
+
+setMethod("E", signature(object = "UnivarMixingDistribution",
+                         fun = "function",
+                         cond = "ANY"),
+    function(object, fun, cond, useApply = TRUE, low = NULL, upp = NULL, 
+             rel.tol= getdistrExOption("ErelativeTolerance"), 
+             lowerTruncQuantile = getdistrExOption("ElowerTruncQuantile"), 
+             upperTruncQuantile = getdistrExOption("EupperTruncQuantile"), 
+             IQR.fac = getdistrExOption("IQR.fac"), ... ){
+        l <- length(object at mixCoeff)
+        Ei <- numeric(l)
+        for(i in 1:l)
+            Ei <- object at mixCoeff[i] * E(object = object at mixDistr[[i]], 
+                                         cond = cond, fun = fun, low = low, 
+                                         upp = upp, rel.tol = rel.tol,
+                                         lowerTruncQuantile = lowerTruncQuantile, 
+                                         upperTruncQuantile = upperTruncQuantile, 
+                                         IQR.fac = IQR.fac, ...)
+        sum(Ei)
+    })

Modified: branches/distr-2.2/pkg/distrEx/chm/00Index.html
===================================================================
--- branches/distr-2.2/pkg/distrEx/chm/00Index.html	2009-05-14 12:17:07 UTC (rev 468)
+++ branches/distr-2.2/pkg/distrEx/chm/00Index.html	2009-05-14 13:28:14 UTC (rev 469)
@@ -282,6 +282,14 @@
 <td>Generic Function for the Computation of (Conditional) Expectations</td></tr>
 <tr><td width="25%"><a href="E.html">E,UnivarLebDecDistribution,missing,missing-method</a></td>
 <td>Generic Function for the Computation of (Conditional) Expectations</td></tr>
+<tr><td width="25%"><a href="E.html">E,UnivarMixingDistribution,function,ANY-method</a></td>
+<td>Generic Function for the Computation of (Conditional) Expectations</td></tr>
+<tr><td width="25%"><a href="E.html">E,UnivarMixingDistribution,function,missing-method</a></td>
+<td>Generic Function for the Computation of (Conditional) Expectations</td></tr>
+<tr><td width="25%"><a href="E.html">E,UnivarMixingDistribution,missing,ANY-method</a></td>
+<td>Generic Function for the Computation of (Conditional) Expectations</td></tr>
+<tr><td width="25%"><a href="E.html">E,UnivarMixingDistribution,missing,missing-method</a></td>
+<td>Generic Function for the Computation of (Conditional) Expectations</td></tr>
 <tr><td width="25%"><a href="E.html">E,Weibull,missing,missing-method</a></td>
 <td>Generic Function for the Computation of (Conditional) Expectations</td></tr>
 <tr><td width="25%"><a href="E.html">E-methods</a></td>

Modified: branches/distr-2.2/pkg/distrEx/chm/0distrEx-package.html
===================================================================
--- branches/distr-2.2/pkg/distrEx/chm/0distrEx-package.html	2009-05-14 12:17:07 UTC (rev 468)
+++ branches/distr-2.2/pkg/distrEx/chm/0distrEx-package.html	2009-05-14 13:28:14 UTC (rev 469)
@@ -74,6 +74,7 @@
 |&gt;|&gt;"AbscontDistribution" (from distr)
 |&gt;|&gt;|&gt;"Gumbel"
 |&gt;|&gt;|&gt;"Pareto"
+|&gt;|&gt;|&gt;"GPareto"
 |&gt;"MultivariateDistribution"
 |&gt;|&gt;"DiscreteMVDistribution-class"
 |&gt;"UnivariateCondDistribution"

Modified: branches/distr-2.2/pkg/distrEx/chm/E.html
===================================================================
--- branches/distr-2.2/pkg/distrEx/chm/E.html	2009-05-14 12:17:07 UTC (rev 468)
+++ branches/distr-2.2/pkg/distrEx/chm/E.html	2009-05-14 13:28:14 UTC (rev 469)
@@ -19,6 +19,7 @@
 <param name="keyword" value="R:   E,DiscreteMVDistribution,missing,missing-method">
 <param name="keyword" value="R:   E,UnivarLebDecDistribution,missing,missing-method">
 <param name="keyword" value="R:   E,AffLinUnivarLebDecDistribution,missing,missing-method">
+<param name="keyword" value="R:   E,UnivarMixingDistribution,missing,missing-method">
 <param name="keyword" value="R:   E,UnivariateDistribution,function,missing-method">
 <param name="keyword" value="R:   E,AbscontDistribution,function,missing-method">
 <param name="keyword" value="R:   E,DiscreteDistribution,function,missing-method">
@@ -26,14 +27,17 @@
 <param name="keyword" value="R:   E,MultivariateDistribution,function,missing-method">
 <param name="keyword" value="R:   E,DiscreteMVDistribution,function,missing-method">
 <param name="keyword" value="R:   E,UnivarLebDecDistribution,function,missing-method">
+<param name="keyword" value="R:   E,UnivarMixingDistribution,function,missing-method">
 <param name="keyword" value="R:   E,AcDcLcDistribution,ANY,ANY-method">
 <param name="keyword" value="R:   E,CompoundDistribution,missing,missing-method">
 <param name="keyword" value="R:   E,UnivariateCondDistribution,missing,numeric-method">
 <param name="keyword" value="R:   E,AbscontCondDistribution,missing,numeric-method">
 <param name="keyword" value="R:   E,DiscreteCondDistribution,missing,numeric-method">
 <param name="keyword" value="R:   E,UnivarLebDecDistribution,missing,ANY-method">
+<param name="keyword" value="R:   E,UnivarMixingDistribution,missing,ANY-method">
 <param name="keyword" value="R:   E,UnivarLebDecDistribution,function,ANY-method">
 <param name="keyword" value="R:   E,UnivariateCondDistribution,function,numeric-method">
+<param name="keyword" value="R:   E,UnivarMixingDistribution,function,ANY-method">
 <param name="keyword" value="R:   E,AbscontCondDistribution,function,numeric-method">
 <param name="keyword" value="R:   E,DiscreteCondDistribution,function,numeric-method">
 <param name="keyword" value="R:   E,Arcsine,missing,missing-method">
@@ -97,6 +101,38 @@
              upperTruncQuantile = getdistrExOption("EupperTruncQuantile"), 
              IQR.fac = getdistrExOption("IQR.fac"), ...)
 
+## S4 method for signature 'UnivarMixingDistribution,
+##   missing, missing':
+E(object, low = NULL, 
+             upp = NULL, rel.tol= getdistrExOption("ErelativeTolerance"), 
+             lowerTruncQuantile = getdistrExOption("ElowerTruncQuantile"), 
+             upperTruncQuantile = getdistrExOption("EupperTruncQuantile"), 
+             IQR.fac = getdistrExOption("IQR.fac"), ...)
+
+## S4 method for signature 'UnivarMixingDistribution,
+##   function, missing':
+E(object, fun, low = NULL, 
+             upp = NULL, rel.tol= getdistrExOption("ErelativeTolerance"), 
+             lowerTruncQuantile = getdistrExOption("ElowerTruncQuantile"), 
+             upperTruncQuantile = getdistrExOption("EupperTruncQuantile"), 
+             IQR.fac = getdistrExOption("IQR.fac"), ...)
+
+## S4 method for signature 'UnivarMixingDistribution,
+##   missing, ANY':
+E(object, cond, low = NULL, 
+             upp = NULL, rel.tol= getdistrExOption("ErelativeTolerance"), 
+             lowerTruncQuantile = getdistrExOption("ElowerTruncQuantile"), 
+             upperTruncQuantile = getdistrExOption("EupperTruncQuantile"), 
+             IQR.fac = getdistrExOption("IQR.fac"), ...)
+
+## S4 method for signature 'UnivarMixingDistribution,
+##   function, ANY':
+E(object, fun, cond, 
+             low = NULL, upp = NULL, rel.tol= getdistrExOption("ErelativeTolerance"), 
+             lowerTruncQuantile = getdistrExOption("ElowerTruncQuantile"), 
+             upperTruncQuantile = getdistrExOption("EupperTruncQuantile"), 
+             IQR.fac = getdistrExOption("IQR.fac"), ...)
+
 ## S4 method for signature 'DiscreteDistribution, function,
 ##   missing':
 E(object, fun, useApply = TRUE, 
@@ -422,6 +458,16 @@
 <dt>object = "UnivarLebDecDistribution", fun = "function", cond = "ANY":</dt><dd>expectation by separate evaluation of expectation of discrete and
 abs. continuous part and subsequent weighting.
 </dd>
+<dt>object = "UnivarMixingDistribution", fun = "missing", cond = "missing":</dt><dd>expectation is computed component-wise with subsequent weighting acc.
+to <code>mixCoeff</code>.</dd>
+<dt>object = "UnivarMixingDistribution", fun = "function", cond = "missing":</dt><dd>expectation is computed component-wise with subsequent weighting acc.
+to <code>mixCoeff</code>.</dd>
+<dt>object = "UnivarMixingDistribution", fun = "missing", cond = "ANY":</dt><dd>expectation is computed component-wise with subsequent weighting acc.
+to <code>mixCoeff</code>.</dd>
+<dt>object = "UnivarMixingDistribution", fun = "function", cond = "ANY":</dt><dd>expectation is computed component-wise with subsequent weighting acc.
+to <code>mixCoeff</code>.</dd>
+
+
 <dt>object = "AcDcLcDistribution", fun = "ANY", cond = "ANY":</dt><dd>expectation by first coercing to class <code>"UnivarLebDecDistribution"</code>
 and using the corresponding method.
 </dd>

Modified: branches/distr-2.2/pkg/distrEx/chm/distrEx.chm
===================================================================
(Binary files differ)

Modified: branches/distr-2.2/pkg/distrEx/chm/distrEx.toc
===================================================================
--- branches/distr-2.2/pkg/distrEx/chm/distrEx.toc	2009-05-14 12:17:07 UTC (rev 468)
+++ branches/distr-2.2/pkg/distrEx/chm/distrEx.toc	2009-05-14 13:28:14 UTC (rev 469)
@@ -446,6 +446,22 @@
 <param name="Local" value="E.html">
 </OBJECT>
 <LI> <OBJECT type="text/sitemap">
+<param name="Name" value="E,UnivarMixingDistribution,function,ANY-method">
+<param name="Local" value="E.html">
+</OBJECT>
+<LI> <OBJECT type="text/sitemap">
+<param name="Name" value="E,UnivarMixingDistribution,function,missing-method">
+<param name="Local" value="E.html">
+</OBJECT>
+<LI> <OBJECT type="text/sitemap">
+<param name="Name" value="E,UnivarMixingDistribution,missing,ANY-method">
+<param name="Local" value="E.html">
+</OBJECT>
+<LI> <OBJECT type="text/sitemap">
+<param name="Name" value="E,UnivarMixingDistribution,missing,missing-method">
+<param name="Local" value="E.html">
+</OBJECT>
+<LI> <OBJECT type="text/sitemap">
 <param name="Name" value="E,Weibull,missing,missing-method">
 <param name="Local" value="E.html">
 </OBJECT>

Modified: branches/distr-2.2/pkg/distrEx/man/E.Rd
===================================================================
--- branches/distr-2.2/pkg/distrEx/man/E.Rd	2009-05-14 12:17:07 UTC (rev 468)
+++ branches/distr-2.2/pkg/distrEx/man/E.Rd	2009-05-14 13:28:14 UTC (rev 469)
@@ -13,6 +13,7 @@
 \alias{E,DiscreteMVDistribution,missing,missing-method}
 \alias{E,UnivarLebDecDistribution,missing,missing-method}
 \alias{E,AffLinUnivarLebDecDistribution,missing,missing-method}
+\alias{E,UnivarMixingDistribution,missing,missing-method}
 \alias{E,UnivariateDistribution,function,missing-method}
 \alias{E,AbscontDistribution,function,missing-method}
 \alias{E,DiscreteDistribution,function,missing-method}
@@ -20,14 +21,17 @@
 \alias{E,MultivariateDistribution,function,missing-method}
 \alias{E,DiscreteMVDistribution,function,missing-method}
 \alias{E,UnivarLebDecDistribution,function,missing-method}
+\alias{E,UnivarMixingDistribution,function,missing-method}
 \alias{E,AcDcLcDistribution,ANY,ANY-method}
 \alias{E,CompoundDistribution,missing,missing-method}
 \alias{E,UnivariateCondDistribution,missing,numeric-method}
 \alias{E,AbscontCondDistribution,missing,numeric-method}
 \alias{E,DiscreteCondDistribution,missing,numeric-method}
 \alias{E,UnivarLebDecDistribution,missing,ANY-method}
+\alias{E,UnivarMixingDistribution,missing,ANY-method}
 \alias{E,UnivarLebDecDistribution,function,ANY-method}
 \alias{E,UnivariateCondDistribution,function,numeric-method}
+\alias{E,UnivarMixingDistribution,function,ANY-method}
 \alias{E,AbscontCondDistribution,function,numeric-method}
 \alias{E,DiscreteCondDistribution,function,numeric-method}
 \alias{E,Arcsine,missing,missing-method}
@@ -74,6 +78,30 @@
              upperTruncQuantile = getdistrExOption("EupperTruncQuantile"), 
              IQR.fac = getdistrExOption("IQR.fac"), ...)
 
+\S4method{E}{UnivarMixingDistribution,missing,missing}(object, low = NULL, 
+             upp = NULL, rel.tol= getdistrExOption("ErelativeTolerance"), 
+             lowerTruncQuantile = getdistrExOption("ElowerTruncQuantile"), 
+             upperTruncQuantile = getdistrExOption("EupperTruncQuantile"), 
+             IQR.fac = getdistrExOption("IQR.fac"), ...)
+
+\S4method{E}{UnivarMixingDistribution,function,missing}(object, fun, low = NULL, 
+             upp = NULL, rel.tol= getdistrExOption("ErelativeTolerance"), 
+             lowerTruncQuantile = getdistrExOption("ElowerTruncQuantile"), 
+             upperTruncQuantile = getdistrExOption("EupperTruncQuantile"), 
+             IQR.fac = getdistrExOption("IQR.fac"), ...)
+
+\S4method{E}{UnivarMixingDistribution,missing,ANY}(object, cond, low = NULL, 
+             upp = NULL, rel.tol= getdistrExOption("ErelativeTolerance"), 
+             lowerTruncQuantile = getdistrExOption("ElowerTruncQuantile"), 
+             upperTruncQuantile = getdistrExOption("EupperTruncQuantile"), 
+             IQR.fac = getdistrExOption("IQR.fac"), ...)
+
+\S4method{E}{UnivarMixingDistribution,function,ANY}(object, fun, cond, 
+             low = NULL, upp = NULL, rel.tol= getdistrExOption("ErelativeTolerance"), 
+             lowerTruncQuantile = getdistrExOption("ElowerTruncQuantile"), 
+             upperTruncQuantile = getdistrExOption("EupperTruncQuantile"), 
+             IQR.fac = getdistrExOption("IQR.fac"), ...)
+
 \S4method{E}{DiscreteDistribution,function,missing}(object, fun, useApply = TRUE, 
              low = NULL, upp = NULL, ...)
 
@@ -305,6 +333,19 @@
         expectation by separate evaluation of expectation of discrete and
         abs. continuous part and subsequent weighting.
         }
+  \item{object = "UnivarMixingDistribution", fun = "missing", cond = "missing":}{
+        expectation is computed component-wise with subsequent weighting acc.
+        to \code{mixCoeff}.}
+  \item{object = "UnivarMixingDistribution", fun = "function", cond = "missing":}{
+        expectation is computed component-wise with subsequent weighting acc.
+        to \code{mixCoeff}.}
+  \item{object = "UnivarMixingDistribution", fun = "missing", cond = "ANY":}{
+        expectation is computed component-wise with subsequent weighting acc.
+        to \code{mixCoeff}.}
+  \item{object = "UnivarMixingDistribution", fun = "function", cond = "ANY":}{
+        expectation is computed component-wise with subsequent weighting acc.
+        to \code{mixCoeff}.}
+
   \item{object = "AcDcLcDistribution", fun = "ANY", cond = "ANY":}{
         expectation by first coercing to class \code{"UnivarLebDecDistribution"}
         and using the corresponding method.



More information about the Distr-commits mailing list