[Distr-commits] r936 - in branches/distr-2.6/pkg: distr distr/R distr/man distrMod distrMod/R distrMod/man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Fri Jun 27 00:18:29 CEST 2014
Author: ruckdeschel
Date: 2014-06-27 00:18:28 +0200 (Fri, 27 Jun 2014)
New Revision: 936
Added:
branches/distr-2.6/pkg/distrMod/R/returnlevelplot.R
branches/distr-2.6/pkg/distrMod/man/returnlevelplot.Rd
Modified:
branches/distr-2.6/pkg/distr/DESCRIPTION
branches/distr-2.6/pkg/distr/R/internals-qqplot.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/qqplot.Rd
branches/distr-2.6/pkg/distrMod/NAMESPACE
branches/distr-2.6/pkg/distrMod/R/AllGeneric.R
branches/distr-2.6/pkg/distrMod/R/qqplot.R
branches/distr-2.6/pkg/distrMod/man/qqplot.Rd
Log:
distrMod: introduced returnlevelplot.R
distr: some minor changes in qqplot
Modified: branches/distr-2.6/pkg/distr/DESCRIPTION
===================================================================
--- branches/distr-2.6/pkg/distr/DESCRIPTION 2014-05-15 12:55:05 UTC (rev 935)
+++ branches/distr-2.6/pkg/distr/DESCRIPTION 2014-06-26 22:18:28 UTC (rev 936)
@@ -3,11 +3,12 @@
Date: 2013-09-13
Title: Object oriented implementation of distributions
Description: S4 Classes and Methods for distributions
-Authors at R: c(person("Florian", "Camphausen", role=c("aut")), person("Matthias", "Kohl",
- role=c("aut", "cph")), person("Peter", "Ruckdeschel", role=c("cre", "cph"),
- email="Peter.Ruckdeschel at itwm.fraunhofer.de"), person("Thomas", "Stabla", role=c("aut",
- "cph")), person("R Core Team", role = c("ctb", "cph"), comment="for source file ks.c/
- routines 'pKS2' and 'pKolmogorov2x'"))
+Authors at R: c(person("Florian", "Camphausen", role=c("aut")),
+ person("Matthias", "Kohl", role=c("aut", "cph")),
+ person("Peter", "Ruckdeschel", role=c("cre", "cph"), email="Peter.Ruckdeschel at itwm.fraunhofer.de"),
+ person("Thomas", "Stabla", role=c("aut", "cph")),
+ person("R Core Team", role = c("ctb", "cph"),
+ comment="for source file ks.c/ routines 'pKS2' and 'pKolmogorov2x'"))
Depends: R(>= 2.14.0), methods, graphics, startupmsg, sfsmisc, SweaveListingUtils
Suggests: distrEx, svUnit (>= 0.7-11)
Imports: stats
Modified: branches/distr-2.6/pkg/distr/R/internals-qqplot.R
===================================================================
--- branches/distr-2.6/pkg/distr/R/internals-qqplot.R 2014-05-15 12:55:05 UTC (rev 935)
+++ branches/distr-2.6/pkg/distr/R/internals-qqplot.R 2014-06-26 22:18:28 UTC (rev 936)
@@ -205,14 +205,15 @@
-.confqq <- function(x,D, withConf.pw = TRUE, withConf.sim = TRUE, alpha,
+.confqq <- function(x,D, datax = TRUE, withConf.pw = TRUE,
+ withConf.sim = TRUE, alpha,
col.pCI, lty.pCI, lwd.pCI, pch.pCI, cex.pCI,
col.sCI, lty.sCI, lwd.sCI, pch.sCI, cex.sCI,
n,exact.sCI=(n<100),exact.pCI=(n<100), nosym.pCI = FALSE,
with.legend = TRUE, legend.bg = "white",
legend.pos = "topleft", legend.cex = 0.8,
legend.pref = "", legend.postf = "",
- legend.alpha = alpha){
+ legend.alpha = alpha, qqb0=NULL){
x <- sort(unique(x))
if("gaps" %in% names(getSlots(class(D))))
@@ -229,36 +230,65 @@
x.d <- x.in[!SI.c]
- qqb <- qqbounds(x,D,alpha,n,withConf.pw, withConf.sim,
- exact.sCI,exact.pCI,nosym.pCI)
+ qqb <- if(is.null(qqb0)) qqbounds(x,D,alpha,n,withConf.pw, withConf.sim,
+ exact.sCI,exact.pCI,nosym.pCI) else qqb0
+
qqb$crit <- qqb$crit[SI.in,]
if(qqb$err["pw"]){
if(sum(SI.c)>0){
- lines(x.c, qqb$crit[SI.c,"pw.right"],
- col=col.pCI,lty=lty.pCI,lwd=lwd.pCI)
- lines(x.c, qqb$crit[SI.c,"pw.left"],
- col=col.pCI,lty=lty.pCI,lwd=lwd.pCI)
+ if(datax){
+ lines(x.c, qqb$crit[SI.c,"pw.right"],
+ col=col.pCI,lty=lty.pCI,lwd=lwd.pCI)
+ lines(x.c, qqb$crit[SI.c,"pw.left"],
+ col=col.pCI,lty=lty.pCI,lwd=lwd.pCI)
+ }else{
+ lines(qqb$crit[SI.c,"pw.right"], x.c,
+ col=col.pCI,lty=lty.pCI,lwd=lwd.pCI)
+ lines(qqb$crit[SI.c,"pw.left"], x.c,
+ col=col.pCI,lty=lty.pCI,lwd=lwd.pCI)
+ }
}
if(sum(!SI.c)>0){
- points(x.d, qqb$crit[!SI.c,"pw.right"],
- col=col.pCI, pch=pch.pCI, cex = cex.pCI)
- points(x.d, qqb$crit[!SI.c,"pw.left"],
- col=col.pCI, pch=pch.pCI, cex = cex.pCI)
+ if(datax){
+ points(x.d, qqb$crit[!SI.c,"pw.right"],
+ col=col.pCI, pch=pch.pCI, cex = cex.pCI)
+ points(x.d, qqb$crit[!SI.c,"pw.left"],
+ col=col.pCI, pch=pch.pCI, cex = cex.pCI)
+ }else{
+ points(qqb$crit[!SI.c,"pw.right"], x.d,
+ col=col.pCI, pch=pch.pCI, cex = cex.pCI)
+ points(qqb$crit[!SI.c,"pw.left"], x.d,
+ col=col.pCI, pch=pch.pCI, cex = cex.pCI)
+ }
}
}
if(qqb$err["sim"]){
if(sum(SI.c)>0){
- lines(x.c, qqb$crit[SI.c,"sim.right"],
+ if(datax){
+ lines(x.c, qqb$crit[SI.c,"sim.right"],
col=col.sCI,lty=lty.sCI,lwd=lwd.sCI)
- lines(x.c, qqb$crit[SI.c,"sim.left"],
+ lines(x.c, qqb$crit[SI.c,"sim.left"],
col=col.sCI,lty=lty.sCI,lwd=lwd.sCI)
+ }else{
+ lines(qqb$crit[SI.c,"sim.right"], x.c,
+ col=col.sCI,lty=lty.sCI,lwd=lwd.sCI)
+ lines(qqb$crit[SI.c,"sim.left"], x.c,
+ col=col.sCI,lty=lty.sCI,lwd=lwd.sCI)
+ }
}
if(sum(!SI.c)>0){
- points(x.d, qqb$crit[!SI.c,"sim.right"],
+ if(datax){
+ points(x.d, qqb$crit[!SI.c,"sim.right"],
col=col.sCI, pch=pch.sCI, cex = cex.sCI)
- points(x.d, qqb$crit[!SI.c,"sim.left"],
+ points(x.d, qqb$crit[!SI.c,"sim.left"],
col=col.sCI, pch=pch.sCI, cex = cex.sCI)
+ }else{
+ points(qqb$crit[!SI.c,"sim.right"], x.d,
+ col=col.sCI, pch=pch.sCI, cex = cex.sCI)
+ points(qqb$crit[!SI.c,"sim.left"], x.d,
+ col=col.sCI, pch=pch.sCI, cex = cex.sCI)
+ }
}
}
if(with.legend){
@@ -301,7 +331,7 @@
merge = FALSE, cex = legend.cex), lcl))
}
}
- return(invisible(NULL))
+ return(invisible(qqb))
}
.deleteItemsMCL <- function(mcl){
Modified: branches/distr-2.6/pkg/distr/R/qqplot.R
===================================================================
--- branches/distr-2.6/pkg/distr/R/qqplot.R 2014-05-15 12:55:05 UTC (rev 935)
+++ branches/distr-2.6/pkg/distr/R/qqplot.R 2014-06-26 22:18:28 UTC (rev 936)
@@ -73,9 +73,9 @@
if(mfColRow) opar1 <- par(mfrow = c(1,1), no.readonly = TRUE)
ret <- do.call(stats::qqplot, args=mcl)
-
- if(withIdLine&& plot.it){
- abline(0,1,col=col.IdL,lty=lty.IdL,lwd=lwd.IdL)
+ qqb <- NULL
+ if(withIdLine){
+ if(plot.it)abline(0,1,col=col.IdL,lty=lty.IdL,lwd=lwd.IdL)
if(#is(y,"AbscontDistribution") &&
withConf){
xy <- unique(sort(c(xc.o,yc.o)))
@@ -97,7 +97,8 @@
xy <- sort(c(xy,xy0,xy1))
}
}
- .confqq(xy, y, withConf.pw, withConf.sim, alpha.CI,
+ if(plot.it){
+ qqb <- .confqq(xy, y, datax=TRUE, withConf.pw, withConf.sim, alpha.CI,
col.pCI, lty.pCI, lwd.pCI, pch.pCI, cex.pCI,
col.sCI, lty.sCI, lwd.sCI, pch.sCI, cex.sCI,
n, exact.sCI = exact.sCI, exact.pCI = exact.pCI,
@@ -105,8 +106,12 @@
legend.bg = legend.bg, legend.pos = legend.pos,
legend.cex = legend.cex, legend.pref = legend.pref,
legend.postf = legend.postf, legend.alpha = legend.alpha)
+ }else{
+ qqb <- qqbounds(sort(unique(xy)),y,alpha.CI,n,withConf.pw, withConf.sim,
+ exact.sCI,exact.pCI,nosym.pCI)
+ }
}
}
- return(ret)
+ return(c(ret,qqb))
})
Modified: branches/distr-2.6/pkg/distr/man/internals-qqplot.Rd
===================================================================
--- branches/distr-2.6/pkg/distr/man/internals-qqplot.Rd 2014-05-15 12:55:05 UTC (rev 935)
+++ branches/distr-2.6/pkg/distr/man/internals-qqplot.Rd 2014-06-26 22:18:28 UTC (rev 936)
@@ -33,14 +33,14 @@
.q2kolmogorov(alpha,n,exact=(n<100))
.q2pw(x,p.b,D,n,alpha,exact=(n<100),nosym=FALSE)
-.confqq(x,D, withConf.pw = TRUE, withConf.sim = TRUE, alpha,
+.confqq(x,D, datax=TRUE, withConf.pw = TRUE, withConf.sim = TRUE, alpha,
col.pCI, lty.pCI, lwd.pCI, pch.pCI, cex.pCI,
col.sCI, lty.sCI, lwd.sCI, pch.sCI, cex.sCI,
n,exact.sCI=(n<100),exact.pCI=(n<100),
nosym.pCI = FALSE, with.legend = TRUE,
legend.bg = "white", legend.pos = "topleft",
legend.cex = 0.8, legend.pref = "", legend.postf = "",
- legend.alpha = alpha)
+ legend.alpha = alpha, qqb0 = NULL)
.deleteItemsMCL(mcl)
.distrExInstalled
@@ -54,6 +54,7 @@
object.
}
\item{D}{object of class \code{"UnivariateDistribution"}}
+\item{datax}{logical; (to be used in \pkg{distrMod}) shall data be plotted on x-axis?}
\item{ord}{integer; the result of a call to \code{order}}
\item{alpha}{numeric in [0,1]; confidence level}
\item{n}{integer; sample size}
@@ -92,6 +93,7 @@
\item{legend.postf}{character to be appended to legend text}
\item{legend.alpha}{nominal coverage probability}
\item{mcl}{arguments in call as a list}
+\item{qqb0}{precomputed return value of \code{qqbounds}}
}
\details{
@@ -157,7 +159,7 @@
columns will be filled with \code{NA}.
\code{.confqq} calls \code{qqbound} to compute the confidence intervals
-and plots them.
+and plots them; returns the return value of qqbound.
\code{.deleteItemsMCL} deletes arguments from a call list which
functions like \code{plot}, \code{lines}, \code{points} cannot digest;
Modified: branches/distr-2.6/pkg/distr/man/qqplot.Rd
===================================================================
--- branches/distr-2.6/pkg/distr/man/qqplot.Rd 2014-05-15 12:55:05 UTC (rev 935)
+++ branches/distr-2.6/pkg/distr/man/qqplot.Rd 2014-06-26 22:18:28 UTC (rev 936)
@@ -105,6 +105,11 @@
\item{x}{The x coordinates of the points that were/would be plotted}
\item{y}{The corresponding quantiles of the second distribution,
\emph{including \code{\link{NA}}s}.}
+ \item{crit}{A matrix with the lower and upper confidence bounds
+ (computed by \code{qqbounds}).}
+ \item{err}{logical vector of length 2.}
+ (elements \code{crit} and \code{err} are taken from the return
+ value(s) of \code{qqbounds}).
}
\references{
Becker, R. A., Chambers, J. M. and Wilks, A. R. (1988)
Modified: branches/distr-2.6/pkg/distrMod/NAMESPACE
===================================================================
--- branches/distr-2.6/pkg/distrMod/NAMESPACE 2014-05-15 12:55:05 UTC (rev 935)
+++ branches/distr-2.6/pkg/distrMod/NAMESPACE 2014-06-26 22:18:28 UTC (rev 936)
@@ -60,7 +60,7 @@
exportMethods("scaleshapename", "scalename", "LogDeriv")
exportMethods("coerce", "profile", "locscalename", "scaleshapename<-")
exportMethods("mleCalc", "mceCalc")
-exportMethods("qqplot")
+exportMethods("qqplot", "returnlevelplot")
export("distrModMASK")
export("trafoEst")
export("distrModOptions", "distrModoptions", "getdistrModOption",
Modified: branches/distr-2.6/pkg/distrMod/R/AllGeneric.R
===================================================================
--- branches/distr-2.6/pkg/distrMod/R/AllGeneric.R 2014-05-15 12:55:05 UTC (rev 935)
+++ branches/distr-2.6/pkg/distrMod/R/AllGeneric.R 2014-06-26 22:18:28 UTC (rev 936)
@@ -287,3 +287,6 @@
if(!isGeneric("scalename")){
setGeneric("scalename", function(object) standardGeneric("scalename"))
}
+if(!isGeneric("returnlevelplot")){
+ setGeneric("returnlevelplot", function(x, y, ...) standardGeneric("returnlevelplot"))
+}
Modified: branches/distr-2.6/pkg/distrMod/R/qqplot.R
===================================================================
--- branches/distr-2.6/pkg/distrMod/R/qqplot.R 2014-05-15 12:55:05 UTC (rev 935)
+++ branches/distr-2.6/pkg/distrMod/R/qqplot.R 2014-06-26 22:18:28 UTC (rev 936)
@@ -49,6 +49,7 @@
withConf.pw = withConf, ### shall pointwise confidence lines be plotted
withConf.sim = withConf, ### shall simultaneous confidence lines be plotted
plot.it = TRUE, ### shall be plotted at all (inherited from stats::qqplot)
+ datax = FALSE, ### as in qqnorm
xlab = deparse(substitute(x)), ## x-label
ylab = deparse(substitute(y)), ## y-label
..., ## further parameters
@@ -174,12 +175,15 @@
if(withLab&& plot.it){
lbprep <- .labelprep(xj,yc,lab.pts,
col.lbl,cex.lbl,which.lbs,which.Order,order.traf)
- text(x = lbprep$x0, y = lbprep$y0, labels = lbprep$lab,
+ xlb0 <- if(datax) lbprep$x0 else lbprep$y0
+ ylb0 <- if(datax) lbprep$y0 else lbprep$x0
+ text(x = xlb0, y = ylb0, labels = lbprep$lab,
cex = lbprep$cex, col = lbprep$col, adj = adj.lbl)
}
- if(withIdLine&& plot.it){
- abline(0,1,col=col.IdL,lty=lty.IdL,lwd=lwd.IdL)
+ qqb <- NULL
+ if(withIdLine){
+ if(plot.it) abline(0,1,col=col.IdL,lty=lty.IdL,lwd=lwd.IdL)
if(#is(y,"AbscontDistribution")&&
withConf){
xy <- unique(sort(c(x,yc.o)))
@@ -202,7 +206,8 @@
}
}
- .confqq(xy, y, withConf.pw, withConf.sim, alpha.CI,
+ if(plot.it){
+ qqb <- .confqq(xy, y, datax, withConf.pw, withConf.sim, alpha.CI,
col.pCI, lty.pCI, lwd.pCI, pch.pCI, cex.pCI,
col.sCI, lty.sCI, lwd.sCI, pch.sCI, cex.sCI,
n, exact.sCI = exact.sCI, exact.pCI = exact.pCI,
@@ -210,9 +215,13 @@
legend.bg = legend.bg, legend.pos = legend.pos,
legend.cex = legend.cex, legend.pref = legend.pref,
legend.postf = legend.postf, legend.alpha = legend.alpha)
+ }else{
+ qqb <- qqbounds(sort(unique(xy)),y,alpha.CI,n,withConf.pw, withConf.sim,
+ exact.sCI,exact.pCI,nosym.pCI)
+ }
}
}
- return(ret)
+ return(c(ret,qqb))
})
## into distrMod
Added: branches/distr-2.6/pkg/distrMod/R/returnlevelplot.R
===================================================================
--- branches/distr-2.6/pkg/distrMod/R/returnlevelplot.R (rev 0)
+++ branches/distr-2.6/pkg/distrMod/R/returnlevelplot.R 2014-06-26 22:18:28 UTC (rev 936)
@@ -0,0 +1,261 @@
+################################################################
+# return level - Plot functions in package distrMod
+################################################################
+
+
+setMethod("returnlevelplot", signature(x = "ANY",
+ y = "UnivariateDistribution"),
+ function(x, ### observations
+ y, ### distribution
+ n = length(x), ### number of points to be plotted
+ withIdLine = TRUE, ### shall line y=x be plotted in
+ withConf = TRUE, ### shall confidence lines be plotted
+ withConf.pw = withConf, ### shall pointwise confidence lines be plotted
+ withConf.sim = withConf, ### shall simultaneous confidence lines be plotted
+ plot.it = TRUE, ### shall be plotted at all (inherited from stats::qqplot)
+ datax = FALSE, ### as in qqnorm
+ MaxOrPOT = c("Max","POT"), ### used for block maxima or points over threshold
+ npy = 365, ### number of observations per year
+ xlab = deparse(substitute(x)), ## x-label
+ ylab = deparse(substitute(y)), ## y-label
+ main = "",
+ ..., ## further parameters
+ width = 10, ## width (in inches) of the graphics device opened
+ height = 5.5, ## height (in inches) of the graphics device opened}
+ withSweave = getdistrOption("withSweave"), ## logical: if \code{TRUE}
+ ## (for working with \command{Sweave}) no extra device is opened and height/width are not set
+ mfColRow = TRUE, ## shall we use panel partition mfrow=c(1,1)?
+ n.CI = n, ## number of points to be used for CI
+ withLab = FALSE, ## shall observation labels be plotted in
+ lab.pts = NULL, ## observation labels to be used
+ which.lbs = NULL, ## which observations shall be labelled
+ which.Order = NULL, ## which of the ordered (remaining) observations shall be labelled
+ order.traf = NULL, ## an optional trafo; by which the observations are ordered (as order(trafo(obs))
+ col.IdL = "red", ## color for the identity line
+ lty.IdL = 2, ## line type for the identity line
+ lwd.IdL = 2, ## line width for the identity line
+ alpha.CI = .95, ## confidence level
+ exact.pCI = (n<100), ## shall pointwise CIs be determined with exact Binomial distribution?
+ exact.sCI = (n<100), ## shall simultaneous CIs be determined with exact kolmogorov distribution?
+ nosym.pCI = FALSE, ## shall we use (shortest) asymmetric CIs?
+ col.pCI = "orange", ## color for the pointwise CI
+ lty.pCI = 3, ## line type for the pointwise CI
+ lwd.pCI = 2, ## line width for the pointwise CI
+ pch.pCI = par("pch"),## symbol for points (for discrete mass points) in pointwise CI
+ cex.pCI = par("cex"),## magnification factor for points (for discrete mass points) in pointwise CI
+ col.sCI = "tomato2", ## color for the simultaneous CI
+ lty.sCI = 4, ## line type for the simultaneous CI
+ lwd.sCI = 2, ## line width for the simultaneous CI
+ pch.sCI = par("pch"),## symbol for points (for discrete mass points) in simultaneous CI
+ cex.sCI = par("cex"),## magnification factor for points (for discrete mass points) in simultaneous CI
+ cex.pch = par("cex"),## magnification factor for the plotted symbols
+ col.pch = par("col"),## color for the plotted symbols
+ cex.lbl = par("cex"),## magnification factor for the plotted observation labels
+ col.lbl = par("col"),## color for the plotted observation labels
+ adj.lbl = NULL, ## adj parameter for the plotted observation labels
+ alpha.trsp = NA, ## alpha transparency to be added afterwards
+ jit.fac = 0, ## jittering factor used for discrete distributions
+ check.NotInSupport = TRUE, ## shall we check if all x lie in support(y)
+ col.NotInSupport = "red", ## if preceding check TRUE color of x if not in support(y)
+ with.legend = TRUE, ## shall a legend be plotted
+ legend.bg = "white", ## background for the legend
+ legend.pos = "topleft", ## position for the legend
+ legend.cex = 0.8, ## magnification factor for the legend
+ legend.pref = "", ## prefix for legend text
+ legend.postf = "", ## postfix for legend text
+ legend.alpha = alpha.CI ## nominal level of CI
+ ){ ## return value as in stats::qqplot
+
+ MaxOrPOT <- match.arg(MaxOrPOT)
+ mc <- match.call(call = sys.call(sys.parent(1)))
+ if(missing(xlab)) mc$xlab <- paste(gettext("Return level of"),
+ as.character(deparse(mc$x)))
+ if(missing(ylab)) mc$ylab <- gettext("Return period (years)")
+ if(missing(main)) mc$main <- gettext("Return level plot")
+ mcl <- as.list(mc)[-1]
+ mcl$MaxOrPOT <- NULL
+ mcl$npy <- NULL
+ mcl$withSweave <- NULL
+ mcl$mfColRow <- NULL
+ mcl$type <-NULL
+ force(x)
+
+
+ xj <- x
+ if(any(.isReplicated(x)))
+ xj[.isReplicated(x)] <- jitter(x[.isReplicated(x)], factor=jit.fac)
+
+ ord.x <- order(xj)
+
+ p2rl <- function(pp){
+ pp <- p(y)(pp)
+ return(if(MaxOrPOT=="Max") -1/log(pp) else 1/(1-pp)/npy)
+ }
+
+ pp <- ppoints(n)
+ yc.o <- q(y)(pp)
+ ycl <- p2rl(yc.o)
+
+ ### extend range somewhat
+ xyall <- sort(unique(c(yc.o,x,
+ q(y)(c(seq(0.01, 0.09, by = 0.01),(1:9)/10,
+ 0.95, 0.99, 0.995, 0.999)),
+ 10^(seq(-1, 3.75 + log10(npy), by = 0.1))
+ )))
+ rxyall <- (max(xyall)-min(xyall))*0.6
+ rxymean <- (max(xyall)+min(xyall))/2
+
+ xyallc <- seq(rxymean-rxyall,rxymean+rxyall, length.out=300)
+ pxyallc <- p2rl(xyallc)
+ xyallc <- xyallc[pxyallc>0.00001 & pxyallc<0.99999]
+ pxyallc <- pxyallc[pxyallc>0.00001 & pxyallc<0.99999]
+
+ if("support" %in% names(getSlots(class(y))))
+ ycl <- sort(jitter(ycl, factor=jit.fac))
+
+ alp.v <- .makeLenAndOrder(alpha.trsp,ord.x)
+ alp.t <- function(x,a1) if(is.na(x)) x else addAlphTrsp2col(x,a1)
+ alp.f <- if(length(alpha.trsp)==1L && is.na(alpha.trsp))
+ function(x,a) x else function(x,a) mapply(x,alp.t,a1=a)
+ cex.pch <- .makeLenAndOrder(cex.pch,ord.x)
+ cex.lbl <- .makeLenAndOrder(cex.lbl,ord.x)
+ col.pch <- alp.f(.makeLenAndOrder(col.pch,ord.x),alp.v)
+ col.lbl <- alp.f(.makeLenAndOrder(col.lbl,ord.x),alp.v)
+
+ if(withLab){
+ if(is.null(lab.pts)) lab.pts <- paste(ord.x)
+ else lab.pts <- .makeLenAndOrder(lab.pts,ord.x)
+ }
+
+ if(check.NotInSupport){
+ xo <- x[ord.x]
+ nInSupp <- which(xo < q(y)(0))
+
+ nInSupp <- unique(sort(c(nInSupp,which( xo > q(y)(1)))))
+ if("support" %in% names(getSlots(class(y))))
+ nInSupp <- unique(sort(c(nInSupp,which( ! xo %in% support(y)))))
+ if("gaps" %in% names(getSlots(class(y))))
+ nInSupp <- unique(sort(c(nInSupp,which( .inGaps(xo,gaps(y))))))
+ if(length(nInSupp)){
+ col.pch[nInSupp] <- col.NotInSupport
+ if(withLab)
+# col.lbl[ord.x[nInSupp]] <- col.NotInSupport
+ col.lbl[nInSupp] <- col.NotInSupport
+ }
+ }
+
+
+ if(n!=length(x)) withLab <- FALSE
+
+ mcl <- .deleteItemsMCL(mcl)
+ mcl$cex <- cex.pch
+ mcl$col <- col.pch
+
+ if (!withSweave){
+ devNew(width = width, height = height)
+ }
+ opar <- par("mfrow", no.readonly = TRUE)
+ if(mfColRow) on.exit(do.call(par, list(mfrow=opar, no.readonly = TRUE)))
+
+ if(mfColRow) opar1 <- par(mfrow = c(1,1), no.readonly = TRUE)
+
+ ret <- list(x=xj,y=ycl)
+
+ if(plot.it){
+ xallc1 <- sort(c(xj,xyallc))
+ yallc1 <- sort(c(ycl,pxyallc))
+ mcl$x <- mcl$y <- NULL
+ if(datax){
+ mcl$xlab <- xlab
+ mcl$ylab <- ylab
+ do.call(plot, c(list(x=xallc1, y=yallc1, log="y",type="n"),mcl))
+ do.call(points, c(list(x=xj, y=ycl), mcl))
+ # ret <- do.call(stats::qqplot, args=mcl0, log="y", ylim = c(0.1,1000))
+ }else{
+ mcl$ylab <- xlab
+ mcl$xlab <- ylab
+ do.call(plot, c(list(x=yallc1, y=xallc1, log="x",type="n"),mcl))
+ do.call(points, c(list(x=ycl, y=xj),mcl))
+ }
+ }
+
+ if(withLab&& plot.it){
+ lbprep <- .labelprep(xj,yc.o,lab.pts,
+ col.lbl,cex.lbl,which.lbs,which.Order,order.traf)
+ lbprep$y0 <- p2rl(lbprep$y0)
+ xlb0 <- if(datax) lbprep$x0 else lbprep$y0
+ ylb0 <- if(datax) lbprep$y0 else lbprep$x0
+ text(x = xlb0, y = ylb0, labels = lbprep$lab,
+ cex = lbprep$cex, col = lbprep$col, adj = adj.lbl)
+ }
+
+ if(withIdLine){
+ if(plot.it){
+ if(datax){
+ lines(xyallc,pxyallc,col=col.IdL,lty=lty.IdL,lwd=lwd.IdL)
+ }else{
+ lines(pxyallc,xyallc,col=col.IdL,lty=lty.IdL,lwd=lwd.IdL)
+ }
+ }
+ qqb <- NULL
+ if(#is(y,"AbscontDistribution")&&
+ withConf){
+ xy <- unique(sort(c(x,yc.o)))
+ xy <- xy[!.NotInSupport(xy,y)]
+ lxy <- length(xy)
+ if(is(y,"DiscreteDistribution")){
+ n0 <- min(n.CI, length(support(y)))
+ n1 <- max(n0-lxy,0)
+ if (n1 >0 ){
+ notyetInXY <- setdiff(support(y), xy)
+ xy0 <- sample(notyetInXY, n1)
+ xy <- sort(unique(c(xy,xy0)))
+ }
+ }else{
+ if(lxy < n.CI){
+ n1 <- (n.CI-lxy)%/%3
+ xy0 <- seq(min(xy),max(xy),length=n1)
+ xy1 <- r(y)(n.CI-lxy-n1)
+ xy <- sort(unique(c(xy,xy0,xy1)))
+ }
+ }
+
+ qqb <- qqbounds(sort(unique(xy)),y,alpha.CI,n,withConf.pw, withConf.sim,
+ exact.sCI,exact.pCI,nosym.pCI)
+ qqb$crit <- p2rl(qqb$crit)
+ if(plot.it){
+ qqb <- .confqq(xy, y, datax, withConf.pw, withConf.sim, alpha.CI,
+ col.pCI, lty.pCI, lwd.pCI, pch.pCI, cex.pCI,
+ col.sCI, lty.sCI, lwd.sCI, pch.sCI, cex.sCI,
+ n, exact.sCI = exact.sCI, exact.pCI = exact.pCI,
+ 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,
+ qqb0=qqb)
+ }
+ }}
+ return(c(ret,qqb))
+ })
+
+## into distrMod
+setMethod("returnlevelplot", signature(x = "ANY",
+ y = "ProbFamily"), function(x, y,
+ n = length(x), withIdLine = TRUE, withConf = TRUE,
+ withConf.pw = withConf, withConf.sim = withConf,
+ plot.it = TRUE, xlab = deparse(substitute(x)),
+ ylab = deparse(substitute(y)), ...){
+
+ mc <- match.call(call = sys.call(sys.parent(1)))
+ if(missing(xlab)) mc$xlab <- as.character(deparse(mc$x))
+ if(missing(ylab)) mc$ylab <- as.character(deparse(mc$y))
+ mcl <- as.list(mc)[-1]
+
+ mcl$y <- yD <- y at distribution
+ if(!is(yD,"UnivariateDistribution"))
+ stop("Not yet implemented.")
+
+ return(do.call(getMethod("returnlevelplot", signature(x="ANY", y="UnivariateDistribution")),
+ args=mcl))
+ })
+
Modified: branches/distr-2.6/pkg/distrMod/man/qqplot.Rd
===================================================================
--- branches/distr-2.6/pkg/distrMod/man/qqplot.Rd 2014-05-15 12:55:05 UTC (rev 935)
+++ branches/distr-2.6/pkg/distrMod/man/qqplot.Rd 2014-06-26 22:18:28 UTC (rev 936)
@@ -6,7 +6,8 @@
\S4method{qqplot}{ANY,UnivariateDistribution}(x,y,
n = length(x), withIdLine = TRUE,
withConf = TRUE, withConf.pw = withConf, withConf.sim = withConf,
- plot.it = TRUE, xlab = deparse(substitute(x)),ylab = deparse(substitute(y)),
+ plot.it = TRUE, datax = FALSE, xlab = deparse(substitute(x)),
+ ylab = deparse(substitute(y)),
..., width = 10, height = 5.5, withSweave = getdistrOption("withSweave"),
mfColRow = TRUE, n.CI = n, withLab = FALSE, lab.pts = NULL, which.lbs = NULL,
which.Order = NULL, order.traf = NULL,
@@ -45,6 +46,7 @@
\item{withConf.sim}{logical; shall simultaneous confidence lines be plotted?}
\item{plot.it}{logical; shall be plotted at all (inherited from
\code{\link[stats:qqnorm]{qqplot}})?}
+\item{datax}{logical; shall data be plotted on x-axis?}
\item{xlab}{x-label}
\item{ylab}{y-label}
\item{\dots}{further parameters for method \code{qqplot} with signature
@@ -122,6 +124,11 @@
\item{x}{The x coordinates of the points that were/would be plotted}
\item{y}{The corresponding quantiles of the second distribution,
\emph{including \code{\link{NA}}s}.}
+ \item{crit}{A matrix with the lower and upper confidence bounds
+ (computed by \code{qqbounds}).}
+ \item{err}{logical vector of length 2.}
+ (elements \code{crit} and \code{err} are taken from the return
+ value(s) of \code{qqbounds}).
}
\details{
\describe{
Added: branches/distr-2.6/pkg/distrMod/man/returnlevelplot.Rd
===================================================================
--- branches/distr-2.6/pkg/distrMod/man/returnlevelplot.Rd (rev 0)
+++ branches/distr-2.6/pkg/distrMod/man/returnlevelplot.Rd 2014-06-26 22:18:28 UTC (rev 936)
@@ -0,0 +1,175 @@
+\name{returnlevelplot}
+\docType{methods}
+\title{Methods for Function returnlevelplot in Package `distrMod'}
+\usage{
+returnlevelplot(x, y, ...)
+\S4method{returnlevelplot}{ANY,UnivariateDistribution}(x,y,
+ n = length(x), withIdLine = TRUE,
+ withConf = TRUE, withConf.pw = withConf, withConf.sim = withConf,
+ plot.it = TRUE, datax = FALSE, MaxOrPOT = c("Max","POT"), npy = 365,
+ xlab = deparse(substitute(x)),
+ ylab = deparse(substitute(y)),
+ main = "",
+ ..., width = 10, height = 5.5, withSweave = getdistrOption("withSweave"),
+ mfColRow = TRUE, n.CI = n, withLab = FALSE, lab.pts = NULL, which.lbs = NULL,
+ which.Order = NULL, order.traf = NULL,
+ col.IdL = "red", lty.IdL = 2, lwd.IdL = 2, alpha.CI = .95,
+ exact.pCI = (n<100), exact.sCI = (n<100), nosym.pCI = FALSE,
+ col.pCI = "orange", lty.pCI = 3, lwd.pCI = 2, pch.pCI = par("pch"),
+ cex.pCI = par("cex"),
+ col.sCI = "tomato2", lty.sCI = 4, lwd.sCI = 2, pch.sCI = par("pch"),
+ cex.sCI = par("cex"),
+ cex.pch = par("cex"), col.pch = par("col"),
+ cex.lbl = par("cex"), col.lbl = par("col"), adj.lbl = NULL,
+ alpha.trsp = NA, 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)
+\S4method{returnlevelplot}{ANY,ProbFamily}(x, y,
+ n = length(x), withIdLine = TRUE, withConf = TRUE,
+ withConf.pw = withConf, withConf.sim = withConf,
+ plot.it = TRUE, xlab = deparse(substitute(x)),
+ ylab = deparse(substitute(y)), ...)
+}
+\alias{returnlevelplot}
+\alias{returnlevelplot-methods}
+\alias{returnlevelplot,ANY,ProbFamily-method}
+\alias{returnlevelplot,ANY,UnivariateDistribution-method}
+
+\arguments{
+\item{x}{data to be checked for compatibility with distribution/model \code{y}.}
+\item{y}{object of class \code{"UnivariateDistribution"} or of
+class \code{"ProbFamily"}.}
+\item{n}{numeric; assumed sample size (by default length of \code{x}).}
+\item{withIdLine}{logical; shall line \code{y = x} be plotted in?}
+\item{withConf}{logical; shall confidence lines be plotted?}
+\item{withConf.pw}{logical; shall pointwise confidence lines be plotted?}
+\item{withConf.sim}{logical; shall simultaneous confidence lines be plotted?}
+\item{plot.it}{logical; shall be plotted at all (inherited from
+\code{\link[stats:qqnorm]{returnlevelplot}})?}
+\item{datax}{logical; shall data be plotted on x-axis?}
+\item{MaxOrPOT}{a character string specifying whether it is used for
+ block maxima ("Max") or for points over threshold ("POT");
+ must be one of ‘"Max"’ (default) or ‘"POT"’.
+ You can specify just the initial letter.}
+\item{npy}{number of observations per year/block.}
+\item{main}{Main title}
+\item{xlab}{x-label}
+\item{ylab}{y-label}
+\item{\dots}{further parameters for method \code{returnlevelplot} with signature
+\code{ANY,UnivariateDistribution} or with function \code{plot}}
+\item{width}{width (in inches) of the graphics device opened}
+\item{height}{height (in inches) of the graphics device opened}
+\item{withSweave}{logical: if \code{TRUE} (for working with \command{Sweave})
+ no extra device is opened and height/width are not set}
+\item{mfColRow}{shall default partition in panels be used --- defaults to \code{TRUE}}
+\item{n.CI}{numeric; number of points to be used for confidence interval}
+\item{withLab}{logical; shall observation labels be plotted in?}
+\item{lab.pts}{character or \code{NULL}; observation labels to be used}
+\item{which.lbs}{integer or \code{NULL}; which observations shall be labelled}
+\item{which.Order}{integer or \code{NULL}; which of the ordered (remaining)
+observations shall be labelled}
+\item{order.traf}{function or \code{NULL}; an optional trafo by which the
+observations are ordered (as order(trafo(obs)).}
+\item{col.IdL}{color for the identity line}
+\item{lty.IdL}{line type for the identity line}
+\item{lwd.IdL}{line width for the identity line}
+\item{alpha.CI}{confidence level}
+\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{col.pCI}{color for the pointwise CI}
+\item{lty.pCI}{line type for the pointwise CI}
+\item{lwd.pCI}{line width for the pointwise CI}
+\item{pch.pCI}{symbol for points (for discrete mass points) in pointwise CI}
+\item{cex.pCI}{magnification factor for points (for discrete mass points) in
+pointwise CI}
+\item{col.sCI}{color for the simultaneous CI}
+\item{lty.sCI}{line type for the simultaneous CI}
+\item{lwd.sCI}{line width for the simultaneous CI}
+\item{pch.sCI}{symbol for points (for discrete mass points) in simultaneous CI}
+\item{cex.sCI}{magnification factor for points (for discrete mass points) in
+simultaneous CI}
+\item{cex.pch}{magnification factor for the plotted symbols}
+\item{col.pch}{color for the plotted symbols}
+\item{cex.lbl}{magnification factor for the plotted observation labels}
+\item{col.lbl}{color for the plotted observation labels}
[TRUNCATED]
To get the complete diff run:
svnlook diff /svnroot/distr -r 936
More information about the Distr-commits
mailing list