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

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Fri Nov 18 13:01:27 CET 2011


Author: ruckdeschel
Date: 2011-11-18 13:01:27 +0100 (Fri, 18 Nov 2011)
New Revision: 755

Modified:
   branches/distr-2.4/pkg/distr/R/internals-qqplot.R
   branches/distr-2.4/pkg/distr/R/qqbounds.R
Log:
argh [distr]/branches: have committed not-yet-to-be-released and still-to-be-checked things in qqbounds.R internals-qqplot.R in rev754 (reverted to rev 751 for the moment)

Modified: branches/distr-2.4/pkg/distr/R/internals-qqplot.R
===================================================================
--- branches/distr-2.4/pkg/distr/R/internals-qqplot.R	2011-11-18 11:51:19 UTC (rev 754)
+++ branches/distr-2.4/pkg/distr/R/internals-qqplot.R	2011-11-18 12:01:27 UTC (rev 755)
@@ -91,18 +91,18 @@
  res <- uniroot(fct,lower=0,upper=1)$root*sqrt(n)
  }else{
  ### from ks.test from package stats:
- 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)
+ 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)
     }
  ###  end of code from package stats
  fct <- function(p0){
@@ -204,8 +204,7 @@
    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	2011-11-18 11:51:19 UTC (rev 754)
+++ branches/distr-2.4/pkg/distr/R/qqbounds.R	2011-11-18 12:01:27 UTC (rev 755)
@@ -16,8 +16,7 @@
    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,11 +27,9 @@
    te.s <- withConf.sim & !is(c.crit,  "try-error")
 
    if(te.s){
-      c.crit.r <- q.r(D)(#pmax(1-p.r-c.crit/sqrt(n),
-                         pmax(1-(1:l.x)/l.x-c.crit/sqrt(n),  
+      c.crit.r <- q.r(D)(pmax(1-p.r-c.crit/sqrt(n),
                          getdistrOption("DistrResolution")),lower.tail=FALSE)
-      c.crit.l <- q(D)(#pmax(p.l-c.crit/sqrt(n),
-                       pmax(((1:l.x)-1)/l.x-c.crit/sqrt(n),
+      c.crit.l <- q(D)(pmax(p.l-c.crit/sqrt(n),
                        getdistrOption("DistrResolution")))
       c.crit.l[abs(c.crit.l)==Inf] <- NA
       c.crit.r[abs(c.crit.r)==Inf] <- NA



More information about the Distr-commits mailing list