[Distr-commits] r447 - in pkg: distr distrEx/R

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

Author: ruckdeschel
Date: 2009-03-31 15:31:30 +0200 (Tue, 31 Mar 2009)
New Revision: 447

Modified:
   pkg/distr/DESCRIPTION
   pkg/distrEx/R/KolmogorovDist.R
Log:
distr: test with svn-tags in DESCRIPTION file
distrEx: changed KolmogorovDist when one operand is DiscreteDistribution

Modified: pkg/distr/DESCRIPTION
===================================================================
--- pkg/distr/DESCRIPTION	2009-03-31 09:47:30 UTC (rev 446)
+++ pkg/distr/DESCRIPTION	2009-03-31 13:31:30 UTC (rev 447)
@@ -10,3 +10,5 @@
 LazyLoad: yes
 License: LGPL-3
 URL: http://distr.r-forge.r-project.org/
+LastChangedDate: {$LastChangedDate$}
+LastChangedRevision: {$LastChangedRevision$}
\ No newline at end of file


Property changes on: pkg/distr/DESCRIPTION
___________________________________________________________________
Name: svn:keywords
   - 
   + HeadURL LastChangedDate LastChangedRevision LastChangedBy

Modified: pkg/distrEx/R/KolmogorovDist.R
===================================================================
--- pkg/distrEx/R/KolmogorovDist.R	2009-03-31 09:47:30 UTC (rev 446)
+++ pkg/distrEx/R/KolmogorovDist.R	2009-03-31 13:31:30 UTC (rev 447)
@@ -60,9 +60,9 @@
 
         o.warn <- getOption("warn"); options(warn = -1)
         on.exit(options(warn=o.warn))
-        x1 <- union(support(e1), r(e2)(1e5))
-        x2 <- seq(from=lower, to=upper, length=1e5)
-        x <- union(x1, x2) 
+        x <- support(e1)
+        #x2 <- seq(from=lower, to=upper, length=1e5)
+        #x <- union(x1, x2) 
 
         res <- max(abs(p(e1)(x)-p(e2)(x)))
         names(res) <- "Kolmogorov distance"
@@ -98,14 +98,15 @@
 setMethod("KolmogorovDist",  signature(e1 = "AcDcLcDistribution",
                                      e2 = "AcDcLcDistribution"),
     function(e1, e2){
+           DISCR <- FALSE
            if( is(e1,"AbscontDistribution"))
                e1 <- as(as(e1,"AbscontDistribution"), "UnivarLebDecDistribution")
            if( is(e2,"AbscontDistribution"))
                e2 <- as(as(e2,"AbscontDistribution"), "UnivarLebDecDistribution")
-           if(is(e1,"DiscreteDistribution"))
-               e1 <- as(as(e1,"DiscreteDistribution"), "UnivarLebDecDistribution")
-           if(is(e2,"DiscreteDistribution"))
-               e2 <- as(as(e2,"DiscreteDistribution"), "UnivarLebDecDistribution")
+           if(is(e1,"DiscreteDistribution")){ DISCR <- TRUE
+               e1 <- as(as(e1,"DiscreteDistribution"), "UnivarLebDecDistribution")}
+           if(is(e2,"DiscreteDistribution")){ DISCR <- TRUE
+               e2 <- as(as(e2,"DiscreteDistribution"), "UnivarLebDecDistribution")}
         if(is.null(e1 at p)){
         e1.erg <- RtoDPQ(e1 at r)
         e1 <- new("UnivariateDistribution", r=e1 at r,
@@ -116,6 +117,8 @@
         e2 <- new("UnivariateDistribution", r=e2 at r,
                    p = e2.erg$pfun, d = e2.erg$dfun, q = e2.erg$qfun,
                    .withSim = TRUE, .withArith = FALSE)}
+        
+        if(!DISCR){
         TruncQuantile <- getdistrOption("TruncQuantile")
         lower1 <- ifelse(!is.finite(q(e1)(0)), q(e1)(TruncQuantile), q(e1)(0))
         upper1 <- ifelse(!is.finite(q(e1)(1)),
@@ -137,7 +140,8 @@
         x1 <- union(r(e1)(1e5), r(e2)(1e5))
         x2 <- seq(from=lower, to=upper, length=1e5)
         x <- union(x1, x2)
-
+        }else 
+         x <- NULL
         if( "support" %in% names(getSlots(class(e1))))
            x <- union(x,e1 at support)
         if( "support" %in% names(getSlots(class(e2))))