[Distr-commits] r938 - in branches/distr-2.6/pkg/distr: R man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Tue Jul 22 18:47:58 CEST 2014
Author: ruckdeschel
Date: 2014-07-22 18:47:58 +0200 (Tue, 22 Jul 2014)
New Revision: 938
Modified:
branches/distr-2.6/pkg/distr/R/internals-qqplot.R
branches/distr-2.6/pkg/distr/R/qqbounds.R
branches/distr-2.6/pkg/distr/R/qqplot.R
branches/distr-2.6/pkg/distr/man/internals-qqplot.Rd
branches/distr-2.6/pkg/distr/man/qqbounds.Rd
branches/distr-2.6/pkg/distr/man/qqplot.Rd
Log:
[distr] integrated debug argument for qqplot qqbounds
Modified: branches/distr-2.6/pkg/distr/R/internals-qqplot.R
===================================================================
--- branches/distr-2.6/pkg/distr/R/internals-qqplot.R 2014-06-26 22:52:18 UTC (rev 937)
+++ branches/distr-2.6/pkg/distr/R/internals-qqplot.R 2014-07-22 16:47:58 UTC (rev 938)
@@ -86,18 +86,12 @@
.C("pkolmogorov2x", p = as.double(p0),
as.integer(n), PACKAGE = "stats")$p
}else function(p0,n){
-# .Call(stats:::C_pKolmogorov2x, p0, n) #, PACKAGE = "stats")
-# .C("pkolmogorov2x", p = as.double(p0),
-# as.integer(n))$p
.Call("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")
-# .C("pkstwo", as.integer(1),
-# p = as.double(x), as.double(tol))$p
.Call("pKS2", p = x, tol) #, PACKAGE = "stats")
}
@@ -113,23 +107,10 @@
}
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)) {
- .pks2(x,tol) -alpha
- #}
- # return(p)
- }
- ### end of code from package stats
fct <- function(p0){
- 1 - pkstwo(p0)-alpha }
- res <- uniroot(fct,lower=0,upper=sqrt(n))$root
+ ### from ks.test from package stats:
+ 1 - .pks2(p0,1e-09)-alpha }
+ res <- uniroot(fct,lower=1e-12,upper=sqrt(n))$root
}
return(res)
}
@@ -184,7 +165,7 @@
pq <- log(p.b)+log(1-p.b)
if(is(D,"AbscontDistribution")){
dp <- d(D)(x,log=TRUE)
- dsupp.p <- dsupp.m<-1
+ dsupp.p <- dsupp.m <- 1
}else{ ## have E and sd available ?
if(!.distrExInstalled) stop("")
supp.ind <- sapply(x, function(y)
@@ -213,7 +194,7 @@
with.legend = TRUE, legend.bg = "white",
legend.pos = "topleft", legend.cex = 0.8,
legend.pref = "", legend.postf = "",
- legend.alpha = alpha, qqb0=NULL){
+ legend.alpha = alpha, qqb0=NULL, debug = FALSE){
x <- sort(unique(x))
if("gaps" %in% names(getSlots(class(D))))
@@ -231,7 +212,7 @@
qqb <- if(is.null(qqb0)) qqbounds(x,D,alpha,n,withConf.pw, withConf.sim,
- exact.sCI,exact.pCI,nosym.pCI) else qqb0
+ exact.sCI,exact.pCI,nosym.pCI, debug) else qqb0
qqb$crit <- qqb$crit[SI.in,]
Modified: branches/distr-2.6/pkg/distr/R/qqbounds.R
===================================================================
--- branches/distr-2.6/pkg/distr/R/qqbounds.R 2014-06-26 22:52:18 UTC (rev 937)
+++ branches/distr-2.6/pkg/distr/R/qqbounds.R 2014-07-22 16:47:58 UTC (rev 938)
@@ -1,7 +1,7 @@
## to be exported: berechnet Konfidenzbänder, simultan und punktweise
qqbounds <- function(x,D,alpha,n,withConf.pw, withConf.sim,
exact.sCI=(n<100),exact.pCI=(n<100),
- nosym.pCI = FALSE){
+ nosym.pCI = FALSE, debug = FALSE){
x <- sort(unique(x))
if("gaps" %in% names(getSlots(class(D))))
{if(!is.null(gaps(D)))
@@ -17,10 +17,21 @@
p.r <- p(D)(x.in)
p.l <- p.l(D)(x.in)
l.x <- length(x.in)
-
+ if(debug){
+ print(SI)
+ print(x.in)
+ print(sum(SI.in))
+ print(cbind(p.r,p.l))
+ print(l.x)
+ print(c(alpha,n,exact.sCI))
+ }
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
-
+ c.crit.i <- if(withConf.pw) try(distr:::.q2pw(x.in,p.r,D,n,alpha,exact.pCI,nosym.pCI),silent=TRUE) else NULL
+ #print(cbind(c.crit,c.crit.i))
+ if(debug){
+ print(str(c.crit))
+ print(str(c.crit.i))
+ }
te.i <- withConf.pw & !is(c.crit.i,"try-error")
te.s <- withConf.sim & !is(c.crit, "try-error")
@@ -46,3 +57,4 @@
}
return(list(crit = c.c, err=c(sim=te.s,pw=te.i)))
}
+# returnlevelplot(xex,datax=FALSE,GEVFamilyMuUnknown(loc=es[1],shape=es[3],scale=es[2]))
Modified: branches/distr-2.6/pkg/distr/R/qqplot.R
===================================================================
--- branches/distr-2.6/pkg/distr/R/qqplot.R 2014-06-26 22:52:18 UTC (rev 937)
+++ branches/distr-2.6/pkg/distr/R/qqplot.R 2014-07-22 16:47:58 UTC (rev 938)
@@ -18,7 +18,7 @@
jit.fac = 0, check.NotInSupport = TRUE,
col.NotInSupport = "red", with.legend = TRUE, legend.bg = "white",
legend.pos = "topleft", legend.cex = 0.8, legend.pref = "",
- legend.postf = "", legend.alpha = alpha.CI){
+ legend.postf = "", legend.alpha = alpha.CI, debug = FALSE){
mc <- match.call(call = sys.call(sys.parent(1)))
if(missing(xlab)) mc$xlab <- as.character(deparse(mc$x))
@@ -105,10 +105,11 @@
nosym.pCI = nosym.pCI, with.legend = with.legend,
legend.bg = legend.bg, legend.pos = legend.pos,
legend.cex = legend.cex, legend.pref = legend.pref,
- legend.postf = legend.postf, legend.alpha = legend.alpha)
+ legend.postf = legend.postf, legend.alpha = legend.alpha,
+ debug = debug)
}else{
qqb <- qqbounds(sort(unique(xy)),y,alpha.CI,n,withConf.pw, withConf.sim,
- exact.sCI,exact.pCI,nosym.pCI)
+ exact.sCI,exact.pCI,nosym.pCI,debug)
}
}
}
Modified: branches/distr-2.6/pkg/distr/man/internals-qqplot.Rd
===================================================================
--- branches/distr-2.6/pkg/distr/man/internals-qqplot.Rd 2014-06-26 22:52:18 UTC (rev 937)
+++ branches/distr-2.6/pkg/distr/man/internals-qqplot.Rd 2014-07-22 16:47:58 UTC (rev 938)
@@ -40,7 +40,7 @@
nosym.pCI = FALSE, with.legend = TRUE,
legend.bg = "white", legend.pos = "topleft",
legend.cex = 0.8, legend.pref = "", legend.postf = "",
- legend.alpha = alpha, qqb0 = NULL)
+ legend.alpha = alpha, qqb0 = NULL, debug = FALSE)
.deleteItemsMCL(mcl)
.distrExInstalled
@@ -94,6 +94,7 @@
\item{legend.alpha}{nominal coverage probability}
\item{mcl}{arguments in call as a list}
\item{qqb0}{precomputed return value of \code{qqbounds}}
+\item{debug}{logical; if \code{TRUE} additional output to debug confidence bounds.}
}
\details{
Modified: branches/distr-2.6/pkg/distr/man/qqbounds.Rd
===================================================================
--- branches/distr-2.6/pkg/distr/man/qqbounds.Rd 2014-06-26 22:52:18 UTC (rev 937)
+++ branches/distr-2.6/pkg/distr/man/qqbounds.Rd 2014-07-22 16:47:58 UTC (rev 938)
@@ -3,7 +3,7 @@
\usage{
qqbounds(x,D,alpha,n,withConf.pw, withConf.sim,
exact.sCI=(n<100),exact.pCI=(n<100),
- nosym.pCI = FALSE)
+ nosym.pCI = FALSE, debug = FALSE)
}
\alias{qqbounds}
@@ -19,6 +19,7 @@
\item{exact.pCI}{logical; shall pointwise CIs be determined with exact Binomial distribution?}
\item{exact.sCI}{logical; shall simultaneous CIs be determined with exact kolmogorov distribution?}
\item{nosym.pCI}{logical; shall we use (shortest) asymmetric CIs?}
+\item{debug}{logical; if \code{TRUE} additional output to debug confidence bounds.}
}
\description{
We compute confidence intervals for QQ plots.
Modified: branches/distr-2.6/pkg/distr/man/qqplot.Rd
===================================================================
--- branches/distr-2.6/pkg/distr/man/qqplot.Rd 2014-06-26 22:52:18 UTC (rev 937)
+++ branches/distr-2.6/pkg/distr/man/qqplot.Rd 2014-07-22 16:47:58 UTC (rev 938)
@@ -24,7 +24,7 @@
jit.fac = 0, check.NotInSupport = TRUE,
col.NotInSupport = "red", with.legend = TRUE, legend.bg = "white",
legend.pos = "topleft", legend.cex = 0.8, legend.pref = "",
- legend.postf = "", legend.alpha = alpha.CI)
+ legend.postf = "", legend.alpha = alpha.CI, debug = FALSE)
\S4method{qqplot}{ANY,ANY}(x, y,
plot.it = TRUE, xlab = deparse(substitute(x)),
ylab = deparse(substitute(y)), ...)
@@ -79,6 +79,7 @@
\item{legend.pref}{character to be prepended to legend text}
\item{legend.postf}{character to be appended to legend text}
\item{legend.alpha}{nominal coverage probability}
+\item{debug}{logical; if \code{TRUE} additional output to debug confidence bounds.}
}
\description{
More information about the Distr-commits
mailing list