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

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

Author: ruckdeschel
Date: 2012-05-22 14:54:41 +0200 (Tue, 22 May 2012)
New Revision: 817

Modified:
   branches/distr-2.4/pkg/distr/R/internals-qqplot.R
   branches/distr-2.4/pkg/distr/R/qqbounds.R
Log:
distr: little changes in internals-qqplot.R (faster ks-distance between distributions) and (still to be thought about): qqbounds.R

Modified: branches/distr-2.4/pkg/distr/R/internals-qqplot.R
===================================================================
--- branches/distr-2.4/pkg/distr/R/internals-qqplot.R	2012-05-22 12:40:14 UTC (rev 816)
+++ branches/distr-2.4/pkg/distr/R/internals-qqplot.R	2012-05-22 12:54:41 UTC (rev 817)
@@ -82,6 +82,9 @@
 }
 
 .q2kolmogorov <- function(alpha,n,exact=(n<100)){ ## Kolmogorovstat
+ if(is.numeric(alpha)) alpha <- as.vector(alpha)
+ else stop("Level alpha must be numeric.")
+ if(any(is.na(alpha))) stop("Level alpha must not contain missings.")
  if(exact){
  fct <- function(p0){
  ### from ks.test from package stats:
@@ -91,18 +94,18 @@
  res <- uniroot(fct,lower=0,upper=1)$root*sqrt(n)
  }else{
  ### from ks.test from package stats:
- pkstwo <- function(x, tol = 1e-06) {
-        if (is.numeric(x))
-            x <- as.vector(x)
-        else stop("argument 'x' must be numeric")
-        p <- rep(0, length(x))
-        p[is.na(x)] <- NA
-        IND <- which(!is.na(x) & (x > 0))
-        if (length(IND)) {
-            p[IND] <- .C("pkstwo", as.integer(length(x[IND])),
-                p = as.double(x[IND]), as.double(tol), PACKAGE = "stats")$p
-        }
-        return(p)
+ pkstwo <- function(x, tol = 1e-09) {
+        #if (is.numeric(x))
+        #    x <- as.vector(x)
+        #else stop("argument 'x' must be numeric")
+        #p <- rep(0, length(x))
+        #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
+        #}
+        # return(p)
     }
  ###  end of code from package stats
  fct <- function(p0){
@@ -204,7 +207,8 @@
    SI.c <- SIi>0
    x.in <- x[SI.in]
    x.c <- x.in[SI.c]
-   x.d <- x.in[!SI.c]
+   x.d <- x.in[!SI.c]        
+   
 
    qqb <- qqbounds(x,D,alpha,n,withConf.pw, withConf.sim,
                    exact.sCI,exact.pCI,nosym.pCI)

Modified: branches/distr-2.4/pkg/distr/R/qqbounds.R
===================================================================
--- branches/distr-2.4/pkg/distr/R/qqbounds.R	2012-05-22 12:40:14 UTC (rev 816)
+++ branches/distr-2.4/pkg/distr/R/qqbounds.R	2012-05-22 12:54:41 UTC (rev 817)
@@ -16,7 +16,8 @@
    x.in <- x[SI.in]
    p.r <- p(D)(x.in)
    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)
@@ -28,8 +29,10 @@
 
    if(te.s){
       c.crit.r <- q.r(D)(pmax(1-p.r-c.crit/sqrt(n),
+                         # alternative: pmax(1-(1:l.x)/l.x-c.crit/sqrt(n),
                          getdistrOption("DistrResolution")),lower.tail=FALSE)
       c.crit.l <- q(D)(pmax(p.l-c.crit/sqrt(n),
+                       # alternative: pmax(((1:l.x)-1)/l.x-c.crit/sqrt(n),
                        getdistrOption("DistrResolution")))
       c.crit.l[abs(c.crit.l)==Inf] <- NA
       c.crit.r[abs(c.crit.r)==Inf] <- NA