[Distr-commits] r442 - in pkg/distrEx: . R chm man

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Wed Mar 25 14:25:41 CET 2009


Author: ruckdeschel
Date: 2009-03-25 14:25:40 +0100 (Wed, 25 Mar 2009)
New Revision: 442

Added:
   pkg/distrEx/chm/PrognCondDistribution.html
   pkg/distrEx/chm/internals.html
   pkg/distrEx/man/PrognCondDistribution.Rd
   pkg/distrEx/man/internals.Rd
Modified:
   pkg/distrEx/NAMESPACE
   pkg/distrEx/R/Expectation.R
   pkg/distrEx/R/PrognCondDistribution.R
   pkg/distrEx/chm/00Index.html
   pkg/distrEx/chm/DiscreteMVDistribution-class.html
   pkg/distrEx/chm/Gumbel-class.html
   pkg/distrEx/chm/Pareto-class.html
   pkg/distrEx/chm/PrognCondDistribution-class.html
   pkg/distrEx/chm/distrEx.chm
   pkg/distrEx/chm/distrEx.hhp
   pkg/distrEx/chm/distrEx.toc
   pkg/distrEx/man/DiscreteMVDistribution-class.Rd
   pkg/distrEx/man/Gumbel-class.Rd
   pkg/distrEx/man/Pareto-class.Rd
   pkg/distrEx/man/PrognCondDistribution-class.Rd
Log:
+distrEx: fixed a bug in E-method for AbscontDistribution, function, cond 
+distrEx: introduced helper function .getIntbounds
+distrEx: reorganized help for PrognCondDistribution   

Modified: pkg/distrEx/NAMESPACE
===================================================================
--- pkg/distrEx/NAMESPACE	2009-03-24 12:21:17 UTC (rev 441)
+++ pkg/distrEx/NAMESPACE	2009-03-25 13:25:40 UTC (rev 442)
@@ -53,3 +53,4 @@
 export("make01","PrognCondDistribution",
        "PrognCondition")
 export("EULERMASCHERONICONSTANT","APERYCONSTANT")
+export(".getIntbound")

Modified: pkg/distrEx/R/Expectation.R
===================================================================
--- pkg/distrEx/R/Expectation.R	2009-03-24 12:21:17 UTC (rev 441)
+++ pkg/distrEx/R/Expectation.R	2009-03-25 13:25:40 UTC (rev 442)
@@ -1,3 +1,19 @@
+## Helper function:
+
+.getIntbounds <- function(object, low, upp, lowTQ, uppTQ, IQR.fac, ...){
+        qx <- q(object)
+        low0 <- qx(lowTQ, lower.tail = TRUE, ...) 
+        upp0 <- ifelse( "lower.tail" %in% names(formals(qx)),
+                       qx(uppTQ, lower.tail = FALSE, ...), 
+                       qx(1-uppTQ, ...))        
+        m <- median(object, ...); s <- IQR(object, ...)
+        low1 <- m - IQR.fac * s 
+        upp1 <- m + IQR.fac * s
+        low <- max(low0,low1,low) 
+        upp <- min(upp0,upp1,upp)
+        return(c(low=low,upp=upp)) 
+}
+
 ## Integration of functions
 setMethod("E", signature(object = "UnivariateDistribution", 
                          fun = "missing", 
@@ -23,13 +39,10 @@
         if(is.null(low)) low <- -Inf
         if(is.null(upp)) upp <- Inf
 
-        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,low) 
-        upp <- min(upp0,upp1,upp) 
+        Ib <- .getIntbounds(object, low, upp, lowerTruncQuantile, 
+              upperTruncQuantile, IQR.fac)
+        low <- Ib["low"]
+        upp <- Ib["upp"]
         
         return(distrExIntegrate(f = integrand, 
                     lower = low,
@@ -146,13 +159,11 @@
         }
         if(is.null(low)) low <- -Inf
         if(is.null(upp)) upp <- Inf
-        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,low) 
-        upp <- min(upp0,upp1,upp) 
+
+        Ib <- .getIntbounds(object, low, upp, lowerTruncQuantile, 
+              upperTruncQuantile, IQR.fac)
+        low <- Ib["low"]
+        upp <- Ib["upp"]
         
         return(distrExIntegrate(f = integrand,
                     lower = low,
@@ -255,14 +266,12 @@
 
         if(is.null(low)) low <- -Inf
         if(is.null(upp)) upp <- Inf
-        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,low) 
-        upp <- min(upp0,upp1,upp) 
 
+        Ib <- .getIntbounds(object, low, upp, lowerTruncQuantile, 
+              upperTruncQuantile, IQR.fac, cond = cond)
+        low <- Ib["low"]
+        upp <- Ib["upp"]
+
         return(distrExIntegrate(integrand, 
               lower = low, upper = upp, rel.tol = rel.tol, distr = object, 
               dfun = d(object), cond = cond))
@@ -337,13 +346,11 @@
 
         if(is.null(low)) low <- -Inf
         if(is.null(upp)) upp <- Inf
-        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,low) 
-        upp <- min(upp0,upp1,upp) 
+
+        Ib <- .getIntbounds(object, low, upp, lowerTruncQuantile, 
+              upperTruncQuantile, IQR.fac, cond = cond)
+        low <- Ib["low"]
+        upp <- Ib["upp"]
         
         return(distrExIntegrate(integrand, 
                 lower = low, upper = upp, rel.tol = rel.tol, distr = object, 

Modified: pkg/distrEx/R/PrognCondDistribution.R
===================================================================
--- pkg/distrEx/R/PrognCondDistribution.R	2009-03-24 12:21:17 UTC (rev 441)
+++ pkg/distrEx/R/PrognCondDistribution.R	2009-03-25 13:25:40 UTC (rev 442)
@@ -15,12 +15,17 @@
 
 setMethod("show", "PrognCondition",
     function(object){
-        cat(gettextf("name:\t%s\n", object at name))
-        cat("range:\t%s with dimension %s\n", object at range@name, object at range@dimension)
+        cat(gettextf("Name:\t%s\n", object at name))
+        cat(gettextf("Range:\t%s with dimension %s\n", object at range@name, 
+            object at range@dimension))
     })
 
 ## generating function
-PrognCondDistribution <- function(Regr = Norm(), Error = Norm()){
+PrognCondDistribution <- function(Regr = Norm(), Error = Norm(),
+             rel.tol= getdistrExOption("ErelativeTolerance"), 
+             lowerTruncQuantile = getdistrExOption("ElowerTruncQuantile"), 
+             upperTruncQuantile = getdistrExOption("EupperTruncQuantile"), 
+             IQR.fac = getdistrExOption("IQR.fac")){
     if(!is(Error, "AbscontDistribution"))
         stop("Error has to be of type 'AbscontDistribution'")
     if(!is(Regr, "AbscontDistribution"))
@@ -34,20 +39,24 @@
     dxfun <- d(Regr)
     dufun <- d(Error)
     qxfun <- q(Regr)
+
+    Ib <- .getIntbounds(Error, low=-Inf, upp=Inf, lowerTruncQuantile, 
+                       upperTruncQuantile, IQR.fac)
+    low <- Ib["low"]
+    upp <- Ib["upp"]
+
+
     eps <-  getdistrOption("TruncQuantile")
     dfun <- function(x, cond, log = FALSE){}
     body(dfun) <- substitute({ dx <- dxfun; du <- dufun; qx <- qxfun
                                dy <- function(cond){ 
-                                  ix <- integrate(f = function(x, cond){ 
+                                  ix <- distrExIntegrate(f = function(x, cond){ 
                                                        dx <- dxfun 
                                                        du <- dufun
                                                        dx(x)*du(cond-x) }, 
-                                        lower = qx(eps), 
-                                        upper =  ifelse( "lower.tail" %in% 
-                                                             names(formals(qx)),
-                                                    qx(eps, lower.tail = FALSE), 
-                                                    qx(1-eps)), 
-                                        cond = cond)$value 
+                                        lower = low, 
+                                        upper = upp, rel.tol=rel.tol,
+                                        cond = cond)
                                   return(ix)
                                   }
                                if ("log" %in% names(formals(dx)) && log)
@@ -58,25 +67,22 @@
                                else d0 <- dx(x)*du(cond-x)/dy(cond)
                                return(d0)
                               },
-                        list(dxfun = dxfun, dufun = dufun, qxfun = qxfun, 
-                             eps = eps))
+                        list(dxfun = dxfun, dufun = dufun, qxfun = qxfun))
  
     pfun <- function(q, cond, lower.tail = TRUE, log.p = FALSE){} 
 
     body(pfun) <- substitute({ d <- dfun; qx <- qxfun
                                if (lower.tail)
-                               p0 <- integrate(f = d, lower = qx(eps), 
-                                      upper = q, cond = cond)$value
+                               p0 <- distrExIntegrate(f = d, lower = low, 
+                                      upper = q, rel.tol = rel.tol, 
+                                      cond = cond)
                                else 
-                               p0 <- integrate(f = d, lower = q, 
-                                      upper = ifelse( "lower.tail" %in% 
-                                                             names(formals(qx)),
-                                                    qx(eps, lower.tail = FALSE), 
-                                                    qx(1-eps)),
-                                      cond = cond)$value
+                               p0 <- distrExIntegrate(f = d, lower = q, 
+                                      upper = upp, rel.tol = rel.tol,
+                                      cond = cond)
                                if (log.p) p0 <- log(p0)
                                },
-                        list(dfun = dfun, qxfun = qxfun, eps = eps))
+                        list(dfun = dfun, qxfun = qxfun))
 
     qufun <- q(Error)
     qfun <- function(p, cond, lower.tail = TRUE, log.p = FALSE){}

Modified: pkg/distrEx/chm/00Index.html
===================================================================
--- pkg/distrEx/chm/00Index.html	2009-03-24 12:21:17 UTC (rev 441)
+++ pkg/distrEx/chm/00Index.html	2009-03-25 13:25:40 UTC (rev 442)
@@ -729,8 +729,8 @@
 <td>Univariate conditional distribution</td></tr>
 <tr><td width="25%"><a href="plot-methods.html">plot-methods</a></td>
 <td>Methods for Function plot in Package 'distrEx'</td></tr>
-<tr><td width="25%"><a href="PrognCondDistribution-class.html">PrognCondDistribution</a></td>
-<td>Posterior distribution in convolution</td></tr>
+<tr><td width="25%"><a href="PrognCondDistribution.html">PrognCondDistribution</a></td>
+<td>Generating function for PrognCondDistribution-class</td></tr>
 <tr><td width="25%"><a href="PrognCondDistribution-class.html">PrognCondDistribution-class</a></td>
 <td>Posterior distribution in convolution</td></tr>
 <tr><td width="25%"><a href="PrognCondition-class.html">PrognCondition</a></td>

Modified: pkg/distrEx/chm/DiscreteMVDistribution-class.html
===================================================================
--- pkg/distrEx/chm/DiscreteMVDistribution-class.html	2009-03-24 12:21:17 UTC (rev 441)
+++ pkg/distrEx/chm/DiscreteMVDistribution-class.html	2009-03-25 13:25:40 UTC (rev 442)
@@ -48,6 +48,12 @@
 optional quantile function </dd>
 <dt><code>support</code>:</dt><dd>numeric matrix whose rows form the
 support of the distribution</dd>
+<dt><code>.withArith</code>:</dt><dd>logical: used internally to issue warnings as to interpretation of arithmetics</dd>
+<dt><code>.withSim</code>:</dt><dd>logical: used internally to issue warnings as to accuracy</dd>
+<dt><code>.logExact</code>:</dt><dd>logical: used internally to flag the case where there are explicit formulae for the
+log version of density, cdf, and quantile function</dd>
+<dt><code>.lowerExact</code>:</dt><dd>logical: used internally to flag the case where there are explicit formulae for the
+lower tail version of cdf and quantile function</dd>
 </dl>
 
 <h3>Extends</h3>
@@ -109,6 +115,6 @@
 </script>
 
 
-<hr><div align="center">[Package <em>distrEx</em> version 2.1 <a href="00Index.html">Index]</a></div>
+<hr><div align="center">[Package <em>distrEx</em> version 2.1 <a href="00Index.html">Index</a>]</div>
 
 </body></html>

Modified: pkg/distrEx/chm/Gumbel-class.html
===================================================================
--- pkg/distrEx/chm/Gumbel-class.html	2009-03-24 12:21:17 UTC (rev 441)
+++ pkg/distrEx/chm/Gumbel-class.html	2009-03-25 13:25:40 UTC (rev 442)
@@ -52,6 +52,13 @@
 <dt><code>d</code>:</dt><dd><code>dgumbel</code></dd>
 <dt><code>p</code>:</dt><dd><code>pgumbel</code></dd>
 <dt><code>q</code>:</dt><dd><code>qgumbel</code></dd>
+<dt><code>gaps</code>:</dt><dd>(numeric) matrix or <code>NULL</code></dd>
+<dt><code>.withArith</code>:</dt><dd>logical: used internally to issue warnings as to interpretation of arithmetics</dd>
+<dt><code>.withSim</code>:</dt><dd>logical: used internally to issue warnings as to accuracy</dd>
+<dt><code>.logExact</code>:</dt><dd>logical: used internally to flag the case where there are explicit formulae for the
+log version of density, cdf, and quantile function</dd>
+<dt><code>.lowerExact</code>:</dt><dd>logical: used internally to flag the case where there are explicit formulae for the
+lower tail version of cdf and quantile function</dd>
 </dl>
 
 <h3>Extends</h3>

Modified: pkg/distrEx/chm/Pareto-class.html
===================================================================
--- pkg/distrEx/chm/Pareto-class.html	2009-03-24 12:21:17 UTC (rev 441)
+++ pkg/distrEx/chm/Pareto-class.html	2009-03-25 13:25:40 UTC (rev 442)
@@ -54,6 +54,13 @@
 <dt><code>d</code>:</dt><dd><code>dpareto1</code></dd>
 <dt><code>p</code>:</dt><dd><code>ppareto1</code></dd>
 <dt><code>q</code>:</dt><dd><code>qpareto1</code></dd>
+<dt><code>gaps</code>:</dt><dd>(numeric) matrix or <code>NULL</code></dd>
+<dt><code>.withArith</code>:</dt><dd>logical: used internally to issue warnings as to interpretation of arithmetics</dd>
+<dt><code>.withSim</code>:</dt><dd>logical: used internally to issue warnings as to accuracy</dd>
+<dt><code>.logExact</code>:</dt><dd>logical: used internally to flag the case where there are explicit formulae for the
+log version of density, cdf, and quantile function</dd>
+<dt><code>.lowerExact</code>:</dt><dd>logical: used internally to flag the case where there are explicit formulae for the
+lower tail version of cdf and quantile function</dd>
 </dl>
 
 <h3>Extends</h3>

Modified: pkg/distrEx/chm/PrognCondDistribution-class.html
===================================================================
--- pkg/distrEx/chm/PrognCondDistribution-class.html	2009-03-24 12:21:17 UTC (rev 441)
+++ pkg/distrEx/chm/PrognCondDistribution-class.html	2009-03-25 13:25:40 UTC (rev 442)
@@ -6,7 +6,6 @@
 
 <table width="100%"><tr><td>PrognCondDistribution-class(distrEx)</td><td align="right">R Documentation</td></tr></table><object type="application/x-oleobject" classid="clsid:1e2a7bd0-dab9-11d0-b93a-00c04fc99f9e">
 <param name="keyword" value="R:   PrognCondDistribution-class">
-<param name="keyword" value="R:   PrognCondDistribution">
 <param name="keyword" value=" Posterior distribution in convolution">
 </object>
 
@@ -21,43 +20,12 @@
 </p>
 
 
-<h3>Usage</h3>
-
-<pre>PrognCondDistribution(Regr = Norm(), Error = Norm())</pre>
-
-
-<h3>Arguments</h3>
-
-<table summary="R argblock">
-<tr valign="top"><td><code>Regr</code></td>
-<td>
-an object of class <code>"AbscontDistribution"</code> </td></tr>
-<tr valign="top"><td><code>Error</code></td>
-<td>
-an object of class <code>"AbscontDistribution"</code> </td></tr>
-</table>
-
-<h3>Details</h3>
-
-<p>
-For independent r.v.'s X,E with univariate, absolutely continuous 
-(a.c.) distributions <code>Regr</code> and <code>Error</code>, respectively, 
-<code>PrognCondDistribution()</code> returns the 
-(factorized, conditional) posterior distribution of X given X+E=y.
-as an object of class <code>PrognCondDistribution</code>.
-</p>
-
-
-<h3>Value</h3>
-
-<p>
-Object of class <code>"PrognCondDistribution"</code></p>
-
 <h3>Objects from the Class</h3>
 
 <p>
-Objects can be created by calls of the form <code>PrognCondDistribution(Regr, Error)</code>
-where <code>Regr</code> and <code>error</code> are the respective (a.c.) distributions of X and E.
+Objects can be created by calls of the form <code><a href="PrognCondDistribution.html">PrognCondDistribution</a></code>
+where <code>Regr</code> and <code>error</code> are the respective (a.c.) distributions of X and E
+and the other arguments control accuracy in integration.
 </p>
 
 
@@ -76,8 +44,13 @@
 optional conditional cumulative distribution function. </dd>
 <dt><code>q</code>:</dt><dd>Object of class <code>"OptionalFunction"</code>:
 optional conditional quantile function. </dd>
+<dt><code>gaps</code>:</dt><dd>(numeric) matrix or <code>NULL</code></dd>
 <dt><code>.withArith</code>:</dt><dd>logical: used internally to issue warnings as to interpretation of arithmetics</dd>
 <dt><code>.withSim</code>:</dt><dd>logical: used internally to issue warnings as to accuracy</dd>
+<dt><code>.logExact</code>:</dt><dd>logical: used internally to flag the case where there are explicit formulae for the
+log version of density, cdf, and quantile function</dd>
+<dt><code>.lowerExact</code>:</dt><dd>logical: used internally to flag the case where there are explicit formulae for the
+lower tail version of cdf and quantile function</dd>
 </dl>
 
 <h3>Extends</h3>
@@ -118,6 +91,6 @@
 </script>
 
 
-<hr><div align="center">[Package <em>distrEx</em> version 2.1 <a href="00Index.html">Index]</a></div>
+<hr><div align="center">[Package <em>distrEx</em> version 2.1 <a href="00Index.html">Index</a>]</div>
 
 </body></html>

Added: pkg/distrEx/chm/PrognCondDistribution.html
===================================================================
--- pkg/distrEx/chm/PrognCondDistribution.html	                        (rev 0)
+++ pkg/distrEx/chm/PrognCondDistribution.html	2009-03-25 13:25:40 UTC (rev 442)
@@ -0,0 +1,101 @@
+<html><head><title>Generating function for PrognCondDistribution-class</title>
+<meta http-equiv="Content-Type" content="text/html; charset=iso-8859-1">
+<link rel="stylesheet" type="text/css" href="Rchm.css">
+</head>
+<body>
+
+<table width="100%"><tr><td>PrognCondDistribution(distrEx)</td><td align="right">R Documentation</td></tr></table><object type="application/x-oleobject" classid="clsid:1e2a7bd0-dab9-11d0-b93a-00c04fc99f9e">
+<param name="keyword" value="R:   PrognCondDistribution">
+<param name="keyword" value=" Generating function for PrognCondDistribution-class">
+</object>
+
+
+<h2>Generating function for PrognCondDistribution-class</h2>
+
+
+<h3>Description</h3>
+
+<p>
+Generates an object of class <code>"PrognCondDistribution"</code>.
+</p>
+
+
+<h3>Usage</h3>
+
+<pre>
+PrognCondDistribution(Regr, Error,
+             rel.tol= getdistrExOption("ErelativeTolerance"), 
+             lowerTruncQuantile = getdistrExOption("ElowerTruncQuantile"), 
+             upperTruncQuantile = getdistrExOption("EupperTruncQuantile"), 
+             IQR.fac = getdistrExOption("IQR.fac"))
+             
+</pre>
+
+
+<h3>Arguments</h3>
+
+<table summary="R argblock">
+<tr valign="top"><td><code>Regr</code></td>
+<td>
+object of class <code>AbscontDistribution</code>;
+the distribution of <code>X</code>. </td></tr>
+<tr valign="top"><td><code>Error</code></td>
+<td>
+object of class <code>AbscontDistribution</code>;
+the distribution of <code>eps</code>. </td></tr>
+<tr valign="top"><td><code>rel.tol</code></td>
+<td>
+relative tolerance for <code>distrExIntegrate</code>.</td></tr>
+<tr valign="top"><td><code>lowerTruncQuantile</code></td>
+<td>
+lower quantile for quantile based integration range.</td></tr>
+<tr valign="top"><td><code>upperTruncQuantile</code></td>
+<td>
+upper quantile for quantile based integration range.</td></tr>
+<tr valign="top"><td><code>IQR.fac</code></td>
+<td>
+factor for scale based integration range (i.e.; 
+median of the distribution <i>+-</i><code>IQR.fac</code><i>*</i>IQR).</td></tr>
+</table>
+
+<h3>Details</h3>
+
+<p>
+For independent r.v.'s X,E with univariate, absolutely continuous 
+(a.c.) distributions <code>Regr</code> and <code>Error</code>, respectively, 
+<code>PrognCondDistribution()</code> returns the 
+(factorized, conditional) posterior distribution of X given X+E=y.
+as an object of class <code>PrognCondDistribution</code>.
+</p>
+
+
+<h3>Value</h3>
+
+<p>
+Object of class <code>"PrognCondDistribution"</code></p>
+
+<h3>Author(s)</h3>
+
+<p>
+Peter Ruckdeschel <a href="mailto:Peter.Ruckdeschel at itwm.fraunhofer.de">Peter.Ruckdeschel at itwm.fraunhofer.de</a>,
+</p>
+
+
+<h3>See Also</h3>
+
+<p>
+<code>PrognCondDistribution-class</code>; demo(&lsquo;<span class="file">Prognose.R</span>&rsquo;).
+</p>
+
+
+<h3>Examples</h3>
+
+<pre>
+PrognCondDistribution(Error = ConvexContamination(Norm(), Norm(4,1), size=0.1))
+</pre>
+
+
+
+<hr><div align="center">[Package <em>distrEx</em> version 2.1 <a href="00Index.html">Index</a>]</div>
+
+</body></html>

Modified: pkg/distrEx/chm/distrEx.chm
===================================================================
(Binary files differ)

Modified: pkg/distrEx/chm/distrEx.hhp
===================================================================
--- pkg/distrEx/chm/distrEx.hhp	2009-03-24 12:21:17 UTC (rev 441)
+++ pkg/distrEx/chm/distrEx.hhp	2009-03-25 13:25:40 UTC (rev 442)
@@ -40,6 +40,7 @@
 Pareto.html
 ParetoParameter-class.html
 PrognCondDistribution-class.html
+PrognCondDistribution.html
 PrognCondition-class.html
 TotalVarDist.html
 UnivariateCondDistribution-class.html
@@ -49,6 +50,7 @@
 distrExIntegrate.html
 distrExMASK.html
 distrExOptions.html
+internals.html
 liesInSupport.html
 m1df.html
 m2df.html

Modified: pkg/distrEx/chm/distrEx.toc
===================================================================
--- pkg/distrEx/chm/distrEx.toc	2009-03-24 12:21:17 UTC (rev 441)
+++ pkg/distrEx/chm/distrEx.toc	2009-03-25 13:25:40 UTC (rev 442)
@@ -1251,7 +1251,7 @@
 </OBJECT>
 <LI> <OBJECT type="text/sitemap">
 <param name="Name" value="PrognCondDistribution">
-<param name="Local" value="PrognCondDistribution-class.html">
+<param name="Local" value="PrognCondDistribution.html">
 </OBJECT>
 <LI> <OBJECT type="text/sitemap">
 <param name="Name" value="PrognCondDistribution-class">
@@ -1727,6 +1727,10 @@
 <param name="Local" value="Pareto.html">
 </OBJECT>
 <LI> <OBJECT type="text/sitemap">
+<param name="Name" value="Generating function for PrognCondDistribution-class">
+<param name="Local" value="PrognCondDistribution.html">
+</OBJECT>
+<LI> <OBJECT type="text/sitemap">
 <param name="Name" value="Generating function for the conditional distribution of a linear regression model.">
 <param name="Local" value="LMCondDistribution.html">
 </OBJECT>

Added: pkg/distrEx/chm/internals.html
===================================================================
--- pkg/distrEx/chm/internals.html	                        (rev 0)
+++ pkg/distrEx/chm/internals.html	2009-03-25 13:25:40 UTC (rev 442)
@@ -0,0 +1,103 @@
+<html><head><title>Internal functions of package distrEx</title>
+<meta http-equiv="Content-Type" content="text/html; charset=iso-8859-1">
+<link rel="stylesheet" type="text/css" href="Rchm.css">
+</head>
+<body>
+
+<table width="100%"><tr><td>internals_for_distrEx(distrEx)</td><td align="right">R Documentation</td></tr></table><object type="application/x-oleobject" classid="clsid:1e2a7bd0-dab9-11d0-b93a-00c04fc99f9e">
+<param name="keyword" value="R:   internals_for_distrEx">
+<param name="keyword" value="R:   .getIntbounds">
+<param name="keyword" value=" Internal functions of package distrEx">
+</object>
+
+
+<h2>Internal functions of package distrEx</h2>
+
+
+<h3>Description</h3>
+
+<p>
+These functions are used internally by package distrEx.
+</p>
+
+
+<h3>Usage</h3>
+
+<pre>
+.getIntbounds(object, low, upp, lowTQ, uppTQ, IQR.fac, ...)
+</pre>
+
+
+<h3>Arguments</h3>
+
+<table summary="R argblock">
+<tr valign="top"><td><code>object</code></td>
+<td>
+an object of class <code>"AbscontDistribution"</code></td></tr>
+<tr valign="top"><td><code>low</code></td>
+<td>
+given lower integration bound</td></tr>
+<tr valign="top"><td><code>upp</code></td>
+<td>
+given lower integration bound</td></tr>
+<tr valign="top"><td><code>lowTQ</code></td>
+<td>
+lower quantile for quantile based integration range.</td></tr>
+<tr valign="top"><td><code>uppTQ</code></td>
+<td>
+upper quantile for quantile based integration range.</td></tr>
+<tr valign="top"><td><code>IQR.fac</code></td>
+<td>
+factor for scale based integration range (i.e.; 
+median of the distribution <i>+-</i><code>IQR.fac</code><i>*</i>IQR).</td></tr>
+<tr valign="top"><td><code>...</code></td>
+<td>
+arguments passed through to other functions (in particular argument
+<code>cond</code> in <code>.getIntbounds</code>)</td></tr>
+</table>
+
+<h3>Details</h3>
+
+<p>
+<code>.getIntbounds</code> integration bounds are obtained
+as <code>lowB &lt;- max(low, q(object)(lowTQ), median(object)-IQR.fac*IQR(object)</code>
+and <code>uppB &lt;- min(upp, q(object)(1-uppTQ), median(object)+IQR.fac*IQR(object)</code>
+</p>
+
+
+<h3>Value</h3>
+
+<table summary="R argblock">
+<tr valign="top"><td><code>.getIntbounds</code></td>
+<td>
+a named numeric vector with coordinates <code>low</code> and <code>upp</code>.</td></tr>
+</table>
+
+<h3>Author(s)</h3>
+
+<p>
+Peter Ruckdeschel <a href="mailto:Peter.Ruckdeschel at itwm.fraunhofer.de">Peter.Ruckdeschel at itwm.fraunhofer.de</a>,
+</p>
+
+
+<h3>See Also</h3>
+
+<p>
+<code><a onclick="findlink('distr', 'AbscontDistribution.html')" style="text-decoration: underline; color: blue; cursor: hand">AbscontDistribution</a></code>,
+<code><a href="distrExIntegrate.html">distrExIntegrate</a></code>
+</p>
+
+<script Language="JScript">
+function findlink(pkg, fn) {
+var Y, link;
+Y = location.href.lastIndexOf("\\") + 1;
+link = location.href.substring(0, Y);
+link = link + "../../" + pkg + "/chtml/" + pkg + ".chm::/" + fn;
+location.href = link;
+}
+</script>
+
+
+<hr><div align="center">[Package <em>distrEx</em> version 2.1 <a href="00Index.html">Index</a>]</div>
+
+</body></html>

Modified: pkg/distrEx/man/DiscreteMVDistribution-class.Rd
===================================================================
--- pkg/distrEx/man/DiscreteMVDistribution-class.Rd	2009-03-24 12:21:17 UTC (rev 441)
+++ pkg/distrEx/man/DiscreteMVDistribution-class.Rd	2009-03-25 13:25:40 UTC (rev 442)
@@ -27,6 +27,12 @@
       optional quantile function }
     \item{\code{support}:}{ numeric matrix whose rows form the
       support of the distribution}
+    \item{\code{.withArith}:}{logical: used internally to issue warnings as to interpretation of arithmetics}
+    \item{\code{.withSim}:}{logical: used internally to issue warnings as to accuracy}
+    \item{\code{.logExact}:}{logical: used internally to flag the case where there are explicit formulae for the
+                              log version of density, cdf, and quantile function}
+    \item{\code{.lowerExact}:}{logical: used internally to flag the case where there are explicit formulae for the
+                              lower tail version of cdf and quantile function}
   }
 }
 \section{Extends}{

Modified: pkg/distrEx/man/Gumbel-class.Rd
===================================================================
--- pkg/distrEx/man/Gumbel-class.Rd	2009-03-24 12:21:17 UTC (rev 441)
+++ pkg/distrEx/man/Gumbel-class.Rd	2009-03-25 13:25:40 UTC (rev 442)
@@ -32,6 +32,13 @@
     \item{\code{d}:}{\code{dgumbel}}
     \item{\code{p}:}{\code{pgumbel}}
     \item{\code{q}:}{\code{qgumbel}}
+    \item{\code{gaps}:}{(numeric) matrix or \code{NULL}}
+    \item{\code{.withArith}:}{logical: used internally to issue warnings as to interpretation of arithmetics}
+    \item{\code{.withSim}:}{logical: used internally to issue warnings as to accuracy}
+    \item{\code{.logExact}:}{logical: used internally to flag the case where there are explicit formulae for the
+                              log version of density, cdf, and quantile function}
+    \item{\code{.lowerExact}:}{logical: used internally to flag the case where there are explicit formulae for the
+                              lower tail version of cdf and quantile function}
   }
 }
 \section{Extends}{

Modified: pkg/distrEx/man/Pareto-class.Rd
===================================================================
--- pkg/distrEx/man/Pareto-class.Rd	2009-03-24 12:21:17 UTC (rev 441)
+++ pkg/distrEx/man/Pareto-class.Rd	2009-03-25 13:25:40 UTC (rev 442)
@@ -34,6 +34,13 @@
     \item{\code{d}:}{\code{dpareto1}}
     \item{\code{p}:}{\code{ppareto1}}
     \item{\code{q}:}{\code{qpareto1}}
+    \item{\code{gaps}:}{(numeric) matrix or \code{NULL}}
+    \item{\code{.withArith}:}{logical: used internally to issue warnings as to interpretation of arithmetics}
+    \item{\code{.withSim}:}{logical: used internally to issue warnings as to accuracy}
+    \item{\code{.logExact}:}{logical: used internally to flag the case where there are explicit formulae for the
+                              log version of density, cdf, and quantile function}
+    \item{\code{.lowerExact}:}{logical: used internally to flag the case where there are explicit formulae for the
+                              lower tail version of cdf and quantile function}
   }
 }
 \section{Extends}{

Modified: pkg/distrEx/man/PrognCondDistribution-class.Rd
===================================================================
--- pkg/distrEx/man/PrognCondDistribution-class.Rd	2009-03-24 12:21:17 UTC (rev 441)
+++ pkg/distrEx/man/PrognCondDistribution-class.Rd	2009-03-25 13:25:40 UTC (rev 442)
@@ -1,13 +1,13 @@
 \name{PrognCondDistribution-class}
 \docType{class}
 \alias{PrognCondDistribution-class}
-\alias{PrognCondDistribution}
 
 \title{Posterior distribution in convolution}
 \description{The posterior distribution of X given (X+E)=y}
 \section{Objects from the Class}{
-Objects can be created by calls of the form \code{PrognCondDistribution(Regr, Error)}
-where \code{Regr} and \code{error} are the respective (a.c.) distributions of X and E.
+Objects can be created by calls of the form \code{\link{PrognCondDistribution}}
+where \code{Regr} and \code{error} are the respective (a.c.) distributions of X and E
+and the other arguments control accuracy in integration.
 }
 \section{Slots}{
   \describe{
@@ -23,26 +23,19 @@
       optional conditional cumulative distribution function. }
     \item{\code{q}:}{Object of class \code{"OptionalFunction"}:
       optional conditional quantile function. }
+    \item{\code{gaps}:}{(numeric) matrix or \code{NULL}}
     \item{\code{.withArith}:}{logical: used internally to issue warnings as to interpretation of arithmetics}
     \item{\code{.withSim}:}{logical: used internally to issue warnings as to accuracy}
+    \item{\code{.logExact}:}{logical: used internally to flag the case where there are explicit formulae for the
+                              log version of density, cdf, and quantile function}
+    \item{\code{.lowerExact}:}{logical: used internally to flag the case where there are explicit formulae for the
+                              lower tail version of cdf and quantile function}
   }
 }
 \section{Extends}{
 Class \code{"AbscontCondDistribution"}, directly.\cr
 Class \code{"Distribution"}, by classes \code{"UnivariateCondDistribution"} and \code{"AbscontCondDistribution"}.
 }
-\usage{PrognCondDistribution(Regr = Norm(), Error = Norm())}
-\arguments{
-  \item{Regr}{ an object of class \code{"AbscontDistribution"} }
-  \item{Error}{ an object of class \code{"AbscontDistribution"} }
-  }
-\details{For independent r.v.'s X,E with univariate, absolutely continuous 
- (a.c.) distributions \code{Regr} and \code{Error}, respectively, 
-  \code{PrognCondDistribution()} returns the 
-  (factorized, conditional) posterior distribution of X given X+E=y.
-  as an object of class \code{PrognCondDistribution}.
-}
-\value{Object of class \code{"PrognCondDistribution"}}
 
 
 %\references{}

Added: pkg/distrEx/man/PrognCondDistribution.Rd
===================================================================
--- pkg/distrEx/man/PrognCondDistribution.Rd	                        (rev 0)
+++ pkg/distrEx/man/PrognCondDistribution.Rd	2009-03-25 13:25:40 UTC (rev 442)
@@ -0,0 +1,46 @@
+\name{PrognCondDistribution}
+\alias{PrognCondDistribution}
+
+\title{Generating function for PrognCondDistribution-class}
+\description{
+  Generates an object of class \code{"PrognCondDistribution"}.
+}
+\usage{
+PrognCondDistribution(Regr, Error,
+             rel.tol= getdistrExOption("ErelativeTolerance"), 
+             lowerTruncQuantile = getdistrExOption("ElowerTruncQuantile"), 
+             upperTruncQuantile = getdistrExOption("EupperTruncQuantile"), 
+             IQR.fac = getdistrExOption("IQR.fac"))
+             
+}
+\arguments{
+  \item{Regr}{object of class \code{AbscontDistribution};
+  the distribution of \code{X}. }
+  \item{Error}{object of class \code{AbscontDistribution};
+  the distribution of \code{eps}. }
+  \item{rel.tol}{relative tolerance for \code{distrExIntegrate}.} 
+  \item{lowerTruncQuantile}{lower quantile for quantile based integration range.}
+  \item{upperTruncQuantile}{upper quantile for quantile based integration range.}
+  \item{IQR.fac}{factor for scale based integration range (i.e.; 
+  median of the distribution \eqn{\pm}{+-}\code{IQR.fac}\eqn{\times}{*}IQR).}
+}
+\details{For independent r.v.'s X,E with univariate, absolutely continuous 
+ (a.c.) distributions \code{Regr} and \code{Error}, respectively, 
+  \code{PrognCondDistribution()} returns the 
+  (factorized, conditional) posterior distribution of X given X+E=y.
+  as an object of class \code{PrognCondDistribution}.
+}
+\value{Object of class \code{"PrognCondDistribution"}}
+%\references{}
+\author{
+  Peter Ruckdeschel \email{Peter.Ruckdeschel at itwm.fraunhofer.de},
+}
+%\note{}
+\seealso{\code{PrognCondDistribution-class}; demo(\file{Prognose.R}).}
+\examples{
+PrognCondDistribution(Error = ConvexContamination(Norm(), Norm(4,1), size=0.1))
+}
+\keyword{distribution}
+\concept{conditional distribution}
+\concept{S4 distribution class}
+\concept{generating function}

Added: pkg/distrEx/man/internals.Rd
===================================================================
--- pkg/distrEx/man/internals.Rd	                        (rev 0)
[TRUNCATED]

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


More information about the Distr-commits mailing list