[Distr-commits] r557 - branches/distr-2.2/pkg/distrEx/R branches/distr-2.2/pkg/distrEx/chm branches/distr-2.2/pkg/distrEx/src pkg/distrEx/R

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

Author: ruckdeschel
Date: 2009-08-27 21:44:01 +0200 (Thu, 27 Aug 2009)
New Revision: 557

Modified:
   branches/distr-2.2/pkg/distrEx/R/KolmogorovDist.R
   branches/distr-2.2/pkg/distrEx/chm/distrEx.chm
   branches/distr-2.2/pkg/distrEx/src/distrEx.dll
   pkg/distrEx/R/KolmogorovDist.R
Log:
yet another (speed) improvement --- important for MDE with KolmogorovDist:
Kolmogorov-dist e1 (discrete) : e2 (ac) is         
        x <- support(e1)
        res <- max(p(e1)(x)-p(e2)(x),p(e2)(x)-p.l(e1)(x))


Modified: branches/distr-2.2/pkg/distrEx/R/KolmogorovDist.R
===================================================================
--- branches/distr-2.2/pkg/distrEx/R/KolmogorovDist.R	2009-08-27 19:15:46 UTC (rev 556)
+++ branches/distr-2.2/pkg/distrEx/R/KolmogorovDist.R	2009-08-27 19:44:01 UTC (rev 557)
@@ -50,21 +50,10 @@
 setMethod("KolmogorovDist", signature(e1 = "DiscreteDistribution",
                                       e2 = "AbscontDistribution"),
     function(e1, e2){
-        TruncQuantile <- getdistrOption("TruncQuantile")
-        lower <- ifelse(!is.finite(q(e2)(0)), q(e2)(TruncQuantile), q(e2)(0))
-        upper <- ifelse(!is.finite(q(e2)(1)), 
-                         ifelse("lower.tail" %in% names(formals(e2 at q)),
-                                q(e2)(TruncQuantile, lower.tail = FALSE),
-                                q(e2)(1-TruncQuantile)), 
-                         q(e2)(1))
-
         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) 
-
-        res <- max(abs(p(e1)(x)-p(e2)(x)))
+        x <- support(e1)
+        res <- max(p(e1)(x)-p(e2)(x),p(e2)(x)-p.l(e1)(x))
         names(res) <- "Kolmogorov distance"
 
         return(res)

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

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

Modified: pkg/distrEx/R/KolmogorovDist.R
===================================================================
--- pkg/distrEx/R/KolmogorovDist.R	2009-08-27 19:15:46 UTC (rev 556)
+++ pkg/distrEx/R/KolmogorovDist.R	2009-08-27 19:44:01 UTC (rev 557)
@@ -50,21 +50,10 @@
 setMethod("KolmogorovDist", signature(e1 = "DiscreteDistribution",
                                       e2 = "AbscontDistribution"),
     function(e1, e2){
-        TruncQuantile <- getdistrOption("TruncQuantile")
-        lower <- ifelse(!is.finite(q(e2)(0)), q(e2)(TruncQuantile), q(e2)(0))
-        upper <- ifelse(!is.finite(q(e2)(1)), 
-                         ifelse("lower.tail" %in% names(formals(e2 at q)),
-                                q(e2)(TruncQuantile, lower.tail = FALSE),
-                                q(e2)(1-TruncQuantile)), 
-                         q(e2)(1))
-
         o.warn <- getOption("warn"); options(warn = -1)
         on.exit(options(warn=o.warn))
         x <- support(e1)
-        #x2 <- seq(from=lower, to=upper, length=1e5)
-        #x <- union(x1, x2) 
-
-        res <- max(abs(p(e1)(x)-p(e2)(x)))
+        res <- max(p(e1)(x)-p(e2)(x),p(e2)(x)-p.l(e1)(x))
         names(res) <- "Kolmogorov distance"
 
         return(res)