[Distr-commits] r829 - branches/distr-2.4/pkg/distr/R

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

Author: ruckdeschel
Date: 2012-09-27 20:27:09 +0200 (Thu, 27 Sep 2012)
New Revision: 829

Modified:
   branches/distr-2.4/pkg/distr/R/internals-qqplot.R
   branches/distr-2.4/pkg/distr/R/qqbounds.R
   branches/distr-2.4/pkg/distr/R/qqplot.R
Log:
fixed a bug within internals-qqplot : withConf.sim, withConf.pw had not been removed from call with 
.deleteItemsMCL; and: BDR has changed calls to .C in 2.16.0 to calls to .Call; we used this in qqbounds, respectively in .q2kolmogorov; now have branching functions .pk2 and .pks2 between ante 2.16. and from 2.16 on

Modified: branches/distr-2.4/pkg/distr/R/internals-qqplot.R
===================================================================
--- branches/distr-2.4/pkg/distr/R/internals-qqplot.R	2012-09-23 10:17:36 UTC (rev 828)
+++ branches/distr-2.4/pkg/distr/R/internals-qqplot.R	2012-09-27 18:27:09 UTC (rev 829)
@@ -81,6 +81,21 @@
    x[ord]
 }
 
+
+.pk2 <- if(getRversion()<"2.16.0") function(p0, n){
+                 .C("pkolmogorov2x", p = as.double(p0),
+                     as.integer(n), PACKAGE = "stats")$p
+        }else function(p0,n){
+                 .Call(stats:::C_pKolmogorov2x, p0, n) #, PACKAGE = "stats")
+        }
+.pks2 <- if(getRversion()<"2.16.0") function(x, tol){
+                 .C("pkstwo", as.integer(1),
+                    p = as.double(x), as.double(tol), PACKAGE = "stats")$p
+        }else function(x, tol){
+                 .Call(stats:::C_pKS2, p = x, tol) #, PACKAGE = "stats")
+        }
+
+
 .q2kolmogorov <- function(alpha,n,exact=(n<100)){ ## Kolmogorovstat
  if(is.numeric(alpha)) alpha <- as.vector(alpha)
  else stop("Level alpha must be numeric.")
@@ -88,8 +103,7 @@
  if(exact){
  fct <- function(p0){
  ### from ks.test from package stats:
-    .C("pkolmogorov2x", p = as.double(p0),
-       as.integer(n), PACKAGE = "stats")$p -alpha
+    .pk2(p0,n) -alpha
   }
  res <- uniroot(fct,lower=0,upper=1)$root*sqrt(n)
  }else{
@@ -102,8 +116,7 @@
         #p[is.na(x)] <- NA
         #IND <- which(!is.na(x) & (x > 0))
         #if (length(IND)) {
-            p <- .C("pkstwo", as.integer(1),
-                    p = as.double(x), as.double(tol), PACKAGE = "stats")$p
+            .pks2(x,tol) -alpha
         #}
         # return(p)
     }
@@ -290,7 +303,8 @@
     mcl$col.IdL <- mcl$alpha.CI <- mcl$lty.IdL <-  NULL
     mcl$col.NotInSupport <- mcl$check.NotInSupport <- NULL
     mcl$exact.sCI <- mcl$exact.pCI <- NULL
-    mcl$withConf <- mcl$withIdLine <- mcl$distance <- NULL
+    mcl$withConf <- mcl$withConf.sim <- mcl$withConf.pw <- NULL
+    mcl$withIdLine <- mcl$distance <- NULL
     mcl$col.pCI <- mcl$lty.pCI <- mcl$col.sCI <- mcl$lty.sCI <- NULL
     mcl$lwd.IdL <- mcl$lwd.pCI <- mcl$lwd.sCI <- NULL
     mcl$withLab <- mcl$lab.pts <- mcl$which.lbs <- NULL

Modified: branches/distr-2.4/pkg/distr/R/qqbounds.R
===================================================================
--- branches/distr-2.4/pkg/distr/R/qqbounds.R	2012-09-23 10:17:36 UTC (rev 828)
+++ branches/distr-2.4/pkg/distr/R/qqbounds.R	2012-09-27 18:27:09 UTC (rev 829)
@@ -18,11 +18,8 @@
    p.l <- p.l(D)(x.in)
    l.x <- length(x.in)
    
-   if(withConf.sim)
-        c.crit <- try(.q2kolmogorov(alpha,n,exact.sCI), silent=TRUE)
-   if(withConf.pw)
-        c.crit.i <- try(
-            .q2pw(x.in,p.r,D,n,alpha,exact.pCI,nosym.pCI),silent=TRUE)
+   c.crit <- if(withConf.sim) try(.q2kolmogorov(alpha,n,exact.sCI), silent=TRUE) else NULL
+   c.crit.i <- if(withConf.pw) try(.q2pw(x.in,p.r,D,n,alpha,exact.pCI,nosym.pCI),silent=TRUE) else NULL
 
    te.i <- withConf.pw  & !is(c.crit.i,"try-error")
    te.s <- withConf.sim & !is(c.crit,  "try-error")

Modified: branches/distr-2.4/pkg/distr/R/qqplot.R
===================================================================
--- branches/distr-2.4/pkg/distr/R/qqplot.R	2012-09-23 10:17:36 UTC (rev 828)
+++ branches/distr-2.4/pkg/distr/R/qqplot.R	2012-09-27 18:27:09 UTC (rev 829)
@@ -62,7 +62,6 @@
     mcl$y <- yc
 
     mcl <- .deleteItemsMCL(mcl)
-
     mcl$cex <- .makeLenAndOrder(cex.pch,ord.x)
     mcl$col <- .makeLenAndOrder(col.pch,ord.x)