[Distr-commits] r117 - in pkg: distr/R distrEx/R distrEx/chm distrEx/src startupmsg/chm

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Mon Apr 21 18:12:35 CEST 2008


Author: ruckdeschel
Date: 2008-04-21 18:12:35 +0200 (Mon, 21 Apr 2008)
New Revision: 117

Removed:
   pkg/distrEx/chm/vonMisesDist.html
Modified:
   pkg/distr/R/ContinuousDistribution.R
   pkg/distrEx/R/ContaminationSize.R
   pkg/distrEx/R/CvMDist.R
   pkg/distrEx/src/distrEx.dll
   pkg/startupmsg/chm/00Index.html
   pkg/startupmsg/chm/StartupUtilities.html
   pkg/startupmsg/chm/myStartupUtilities.html
   pkg/startupmsg/chm/startupmsg.chm
Log:
---------------
pkg:distr:
---------------
ContinuousDistribution.R: inserted "return"-tag to be sure...
---------------
pkg:distrEx:
---------------
ContaminationSize.R: new computation for DiscreteDistribution
CvMDist.R: for UnivariateDistribution --- if slot p is missing it is filled by RtoDPQ()


Modified: pkg/distr/R/ContinuousDistribution.R
===================================================================
--- pkg/distr/R/ContinuousDistribution.R	2008-04-21 04:40:11 UTC (rev 116)
+++ pkg/distr/R/ContinuousDistribution.R	2008-04-21 16:12:35 UTC (rev 117)
@@ -258,6 +258,7 @@
                         if (log) dx <- log(dx)                    
                     } 
                     dx <- if (log) dx - (x>0) * log(abs(x1)) else  dx/abs(x1) 
+                    return(dx)
             }
             
             pnew <- function(q, lower.tail = TRUE, log.p = FALSE){

Modified: pkg/distrEx/R/ContaminationSize.R
===================================================================
--- pkg/distrEx/R/ContaminationSize.R	2008-04-21 04:40:11 UTC (rev 116)
+++ pkg/distrEx/R/ContaminationSize.R	2008-04-21 16:12:35 UTC (rev 117)
@@ -10,16 +10,23 @@
         lower <- min(q(e1)(1e-10), q(e2)(1e-10))
         upper <- max(q(e1)(1-1e-10), q(e2)(1-1e-10))
         x <- seq(from = lower, to = upper, length = 1e5)
-        fct <- function(rad, x, dfun1, dfun2){
-            return(min(dfun2(x) - (1-rad)*dfun1(x)))
-        }
-        res <- try(uniroot(f = fct, interval = c(-1e-3,1+1e-3), 
-                    tol = .Machine$double.eps^0.25, x = x, 
-                    dfun1 = d(e1), dfun2 = d(e2))$root, silent=TRUE)
-        if(!is.numeric(res)){ 
-            return(list(e1 = e1, e2 = e2, size.of.contamination = 1))
-        }
         
+        d10  <- d(e1)(x); d1 <- d10[ d10>0 ]
+        d20  <- d(e2)(x); d2 <- d20[ d10>0 ]
+        
+        res <- min(1- min(d2/d1),1)
+        if(any(d10 == 0 & d20 >0)) res <- 1
+
+#        fct <- function(rad, x, dfun1, dfun2){
+#            return(min(dfun2(x) - (1-rad)*dfun1(x)))
+#        }
+#        res <- try(uniroot(f = fct, interval = c(-1e-3,1+1e-3), 
+#                    tol = .Machine$double.eps^0.25, x = x, 
+#                    dfun1 = d(e1), dfun2 = d(e2))$root, silent=TRUE)
+#        if(!is.numeric(res)){ 
+#            return(list(e1 = e1, e2 = e2, size.of.contamination = 1))
+#        }
+        
         return(list(e1 = e1, e2 = e2, size.of.contamination = res))
 #        fct <- function(x, e1, e2){
 #            p1 <- p(e1)(x)
@@ -46,11 +53,17 @@
 #        return(res)
 
         owarn <- getOption("warn"); options(warn = -1)
-        supp <- union(support(e1), support(e2))
-        p1 <- p(e1)(supp)
-        p2 <- p(e2)(supp)[p1 != 0]
-        p1 <- p1[p1 != 0]
-        res <- round(1 - exp(min(log(p2) - log(p1))), 2)
+        x <- union(support(e1), support(e2))
+#        p1 <- p(e1)(supp)
+#        p2 <- p(e2)(supp)[p1 != 0]
+#        p1 <- p1[p1 != 0]
+#        res <- round(1 - exp(min(log(p2) - log(p1))), 2)
+        d10  <- d(e1)(x); d1 <- d10[ d10>0 ]
+        d20  <- d(e2)(x); d2 <- d20[ d10>0 ]
+        
+        res <- min(1- min(d2/d1),1)
+        if(any(d10 == 0 & d20 >0)) res <- 1
+
         options(warn = owarn)
 
 

Modified: pkg/distrEx/R/CvMDist.R
===================================================================
--- pkg/distrEx/R/CvMDist.R	2008-04-21 04:40:11 UTC (rev 116)
+++ pkg/distrEx/R/CvMDist.R	2008-04-21 16:12:35 UTC (rev 117)
@@ -6,6 +6,16 @@
                                     e2 = "UnivariateDistribution"),
     function(e1, e2, mu = e2, useApply = FALSE, ... ){
         owarn <- getOption("warn"); options(warn = -1)
+        if(is.null(e1 at p)){
+        e1.erg <- RtoDPQ(e1 at r)
+        e1 <- new("UnivariateDistribution", r=e1 at r, 
+                   p = e1.erg$pfun, d = e1.erg$dfun, q = e1.erg$qfun,  
+                   .withSim = TRUE, .withArith = FALSE)}
+        if(is.null(e2 at p)){
+        e2.erg <- RtoDPQ(e2 at r)
+        e2 <- new("UnivariateDistribution", r=e2 at r, 
+                   p = e2.erg$pfun, d = e2.erg$dfun, q = e2.erg$qfun,  
+                   .withSim = TRUE, .withArith = FALSE)}
         res <- E(mu, fun = function(t) {(p(e1)(t)-p(e2)(t))^2}, useApply = useApply, ...)^.5
         names(res) <- "CvM distance"
         options(warn = owarn)

Deleted: pkg/distrEx/chm/vonMisesDist.html
===================================================================
--- pkg/distrEx/chm/vonMisesDist.html	2008-04-21 04:40:11 UTC (rev 116)
+++ pkg/distrEx/chm/vonMisesDist.html	2008-04-21 16:12:35 UTC (rev 117)
@@ -1,131 +0,0 @@
-<html><head><title>Generic function for the computation of the vonMises distance of two distributions</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>vonMisesDist(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:   vonMisesDist">
-<param name="keyword" value="R:   vonMisesDist-methods">
-<param name="keyword" value="R:   vonMisesDist,UnivariateDistribution,UnivariateDistribution-method">
-<param name="keyword" value="R:   vonMisesDist,numeric,UnivariateDistribution-method">
-<param name="keyword" value=" Generic function for the computation of the vonMises distance of two distributions">
-</object>
-
-
-<h2>Generic function for the computation of the vonMises distance of two distributions</h2>
-
-
-<h3>Description</h3>
-
-<p>
-Generic function for the computation of the von Mises distance <i>d_{mu}</i>
-of two distributions <i>P</i> and <i>Q</i> where the distributions are defined 
-on a finite-dimensional Euclidean space <i>(R^m, B^m)</i>
-with <i>B^m</i> the Borel-<i>sigma</i>-algebra on <i>R^m</i>.
-The von Mises distance is defined as
-</p><p align="center"><i>d_{mu}(P,Q)^2=int (P({y in R^m | y &lt;= x})-Q({y in R^m | y &lt;= x}))^2 mu(dx)</i></p><p>
-where <i>&lt;=</i> is coordinatewise on <i>R^m</i>.
-</p>
-
-
-<h3>Usage</h3>
-
-<pre>
-vonMisesDist(e1, e2, ...)
-## S4 method for signature 'UnivariateDistribution,
-##   UnivariateDistribution':
-vonMisesDist(e1, e2, mu = e2, useApply = FALSE, ...)
-## S4 method for signature 'numeric,
-##   UnivariateDistribution':
-vonMisesDist(e1, e2, mu = e2, ...)
-</pre>
-
-
-<h3>Arguments</h3>
-
-<table summary="R argblock">
-<tr valign="top"><td><code>e1</code></td>
-<td>
-object of class <code>"Distribution"</code> or class <code>"numeric"</code> </td></tr>
-<tr valign="top"><td><code>e2</code></td>
-<td>
-object of class <code>"Distribution"</code> </td></tr>
-<tr valign="top"><td><code>...</code></td>
-<td>
-further arguments to be used e.g. by <code>E()</code></td></tr>
-<tr valign="top"><td><code>useApply</code></td>
-<td>
-logical; to be passed to <code><a href="E.html">E</a>()</code></td></tr>
-<tr valign="top"><td><code>mu</code></td>
-<td>
-object of class <code>"Distribution"</code>; integration measure; defaulting to <code>e2</code> </td></tr>
-</table>
-
-<h3>Value</h3>
-
-<p>
-von Mises distance of <code>e1</code> and <code>e2</code></p>
-
-<h3>Methods</h3>
-
-<dl>
-<dt>e1 = "UnivariateDistribution", e2 = "UnivariateDistribution":</dt><dd>von Mises distance of two univariate distributions.
-</dd>
-<dt>e1 = "numeric", e2 = "UnivariateDistribution":</dt><dd>von Mises distance between the empirical formed from a data set (e1) and a 
-univariate distribution. 
-</dd>
-</dl>
-
-<h3>Author(s)</h3>
-
-<p>
-Matthias Kohl <a href="mailto:Matthias.Kohl at stamats.de">Matthias.Kohl at stamats.de</a>,<br>
-Peter Ruckdeschel <a href="mailto:Peter.Ruckdeschel at uni-bayreuth.de">Peter.Ruckdeschel at uni-bayreuth.de</a>
-</p>
-
-
-<h3>References</h3>
-
-<p>
-Rieder, H. (1994) <EM>Robust Asymptotic Statistics</EM>. New York: Springer.
-</p>
-
-
-<h3>See Also</h3>
-
-<p>
-<code><a href="ContaminationSize.html">ContaminationSize</a></code>, <code><a href="TotalVarDist.html">TotalVarDist</a></code>, 
-<code><a href="HellingerDist.html">HellingerDist</a></code>, <code><a href="KolmogorovDist.html">KolmogorovDist</a></code>,
-<code><a onclick="findlink('distr', 'Distribution-class.html')" style="text-decoration: underline; color: blue; cursor: hand">Distribution-class</a></code>
-</p>
-
-
-<h3>Examples</h3>
-
-<pre>
-vonMisesDist(Norm(), Gumbel())
-vonMisesDist(Norm(), Gumbel(), mu = Norm())
-vonMisesDist(Norm(), Td(10))
-vonMisesDist(Norm(mean = 50, sd = sqrt(25)), Binom(size = 100))
-vonMisesDist(Pois(10), Binom(size = 20)) 
-vonMisesDist(rnorm(100),Norm())
-vonMisesDist((rbinom(50, size = 20, prob = 0.5)-10)/sqrt(5), Norm())
-vonMisesDist(rbinom(50, size = 20, prob = 0.5), Binom(size = 20, prob = 0.5))
-vonMisesDist(rbinom(50, size = 20, prob = 0.5), Binom(size = 20, prob = 0.5), mu = Pois())
-</pre>
-
-<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.0 <a href="00Index.html">Index]</a></div>
-
-</body></html>

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

Modified: pkg/startupmsg/chm/00Index.html
===================================================================
--- pkg/startupmsg/chm/00Index.html	2008-04-21 04:40:11 UTC (rev 116)
+++ pkg/startupmsg/chm/00Index.html	2008-04-21 16:12:35 UTC (rev 117)
@@ -10,7 +10,7 @@
 <param name="keyword" value=".. contents">
 </object>
 
-<h2>Help pages for package `startupmsg' version 0.5</h2>
+<h2>Help pages for package &lsquo;startupmsg&rsquo; version 0.5</h2>
 
 
 <table width="100%">

Modified: pkg/startupmsg/chm/StartupUtilities.html
===================================================================
--- pkg/startupmsg/chm/StartupUtilities.html	2008-04-21 04:40:11 UTC (rev 116)
+++ pkg/startupmsg/chm/StartupUtilities.html	2008-04-21 16:12:35 UTC (rev 117)
@@ -1,5 +1,5 @@
 <html><head><title>Utilities for start-up messages</title>
-<meta http-equiv="Content-Type" content="text/html; charset=">
+<meta http-equiv="Content-Type" content="text/html; charset=iso-8859-1">
 <link rel="stylesheet" type="text/css" href="Rchm.css">
 </head>
 <body>
@@ -100,18 +100,18 @@
 <h3>Details</h3>
 
 <p>
-<code>readVersionInformation</code> and <code>readURLInformation</code> read the &lsquo;<TT>DESCRIPTION</TT>&rsquo; file of the package.
+<code>readVersionInformation</code> and <code>readURLInformation</code> read the &lsquo;<span class="file">DESCRIPTION</span>&rsquo; file of the package.
 <code>readVersionInformation</code> returns a list with elements <code>ver</code> and <code>title</code> for the version and title 
-to be found in the &lsquo;<TT>DESCRIPTION</TT>&rsquo; file; if there is a <code>URL</code> entry it is returned by <code>readURLInformation</code>
+to be found in the &lsquo;<span class="file">DESCRIPTION</span>&rsquo; file; if there is a <code>URL</code> entry it is returned by <code>readURLInformation</code>
 else <code>readURLInformation</code> returns <code>NULL</code>.
 </p>
 <p>
-If there is a &lsquo;<TT>NEWS</TT>&rsquo; in the package main folder, <code>pointertoNEWS</code> returns a string with an expression how
+If there is a &lsquo;<span class="file">NEWS</span>&rsquo; in the package main folder, <code>pointertoNEWS</code> returns a string with an expression how
 to retrieve this file from within R, else <code>pointertoNEWS</code>  returns <code>NULL</code>.
 </p>
 <p>
 <code>infoShow</code> displays the file <code>filename</code> in the package main folder using <code>file.show</code> &ndash; if it exists;
-<code>NEWS</code> in particular displays the &lsquo;<TT>NEWS</TT>&rsquo; file; takes up an idea by Andy Liaw.
+<code>NEWS</code> in particular displays the &lsquo;<span class="file">NEWS</span>&rsquo; file; takes up an idea by Andy Liaw.
 </p>
 <p>
 A new sub-condition <code>StartupMessage</code> to <code>message</code> is introduced, 
@@ -138,7 +138,7 @@
 suppresses all messages issued by <code>startupMessage</code> in the expression <code>expr</code> within the parentheses
 <li><code>suppressPackageStartupMessages(expr)</code>: 
 from package version 0.5 on, is the same as <code>suppressStartupMessages</code> for our start-up banners, but more 
-generally suppresses all messages of S3-class <code>packageStartupMessage</code> (from <STRONG>base</STRONG> package)
+generally suppresses all messages of S3-class <code>packageStartupMessage</code> (from <span class="pkg">base</span> package)
 <li><code>onlyversionStartupMessages(expr, atypes="version")</code> 
 only shows messages issued by <code>startupMessage</code> in the expression <code>expr</code> within the parentheses, if
 there slot <code>type</code> is contained in the <code>atypes</code> argument

Modified: pkg/startupmsg/chm/myStartupUtilities.html
===================================================================
--- pkg/startupmsg/chm/myStartupUtilities.html	2008-04-21 04:40:11 UTC (rev 116)
+++ pkg/startupmsg/chm/myStartupUtilities.html	2008-04-21 16:12:35 UTC (rev 117)
@@ -1,5 +1,5 @@
 <html><head><title>Example functions to utilities for start-up messages</title>
-<meta http-equiv="Content-Type" content="text/html; charset=">
+<meta http-equiv="Content-Type" content="text/html; charset=iso-8859-1">
 <link rel="stylesheet" type="text/css" href="Rchm.css">
 </head>
 <body>
@@ -106,8 +106,8 @@
 <li>additional messages of class <code>StartupMessage</code> and of type <code>"notabene"</code> according to the ... argument
 <li>a message of class <code>StartupMessage</code> and of type <code>"information"</code> mentioning<br>
 <ul><li><code>?"</code><VAR>&lt;pkg-name&gt;</VAR><code>"</code> &ndash; according to argument <code>packageHelp</code>,  
-<li><code>NEWS("</code><VAR>&lt;pkg-name&gt;</VAR><code>")</code>, if there is a &lsquo;<TT>NEWS</TT>&rsquo; file,   
-<li><code>URL</code>, if there is a <code>URL</code> mentioned in the &lsquo;<TT>DESCRIPTION</TT>&rsquo; file,   
+<li><code>NEWS("</code><VAR>&lt;pkg-name&gt;</VAR><code>")</code>, if there is a &lsquo;<span class="file">NEWS</span>&rsquo; file,   
+<li><code>URL</code>, if there is a <code>URL</code> mentioned in the &lsquo;<span class="file">DESCRIPTION</span>&rsquo; file,   
 <li>if there is a  <code>MANUAL</code> argument, the file / the URL to this manual 
 <li>if there is a  <code>VIGNETTE</code> argument, <code>VIGNETTE</code> is printed out indicating a vignette location
 </ul>

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



More information about the Distr-commits mailing list