[Distr-commits] r987 - in branches/distr-2.6/pkg/distr: R inst man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Thu Jan 15 23:46:56 CET 2015
Author: ruckdeschel
Date: 2015-01-15 23:46:56 +0100 (Thu, 15 Jan 2015)
New Revision: 987
Modified:
branches/distr-2.6/pkg/distr/R/plot-methods.R
branches/distr-2.6/pkg/distr/R/plot-methods_LebDec.R
branches/distr-2.6/pkg/distr/R/qqplot.R
branches/distr-2.6/pkg/distr/inst/NEWS
branches/distr-2.6/pkg/distr/man/plot-methods.Rd
branches/distr-2.6/pkg/distr/man/qqplot.Rd
Log:
[distr] plot methods gain argument withSubst to control pattern substitution in titles and axis lables; qqplot now also offers pattern substitution
Modified: branches/distr-2.6/pkg/distr/R/plot-methods.R
===================================================================
--- branches/distr-2.6/pkg/distr/R/plot-methods.R 2014-12-04 19:14:13 UTC (rev 986)
+++ branches/distr-2.6/pkg/distr/R/plot-methods.R 2015-01-15 22:46:56 UTC (rev 987)
@@ -10,7 +10,7 @@
col.vert = par("col"), col.main = par("col.main"),
col.inner = par("col.main"), col.sub = par("col.sub"),
cex.points = 2.0, pch.u = 21, pch.a = 16, mfColRow = TRUE,
- to.draw.arg = NULL){
+ to.draw.arg = NULL, withSubst = TRUE){
xc <- match.call(call = sys.call(sys.parent(1)))$x
### manipulating the ... - argument
@@ -101,7 +101,8 @@
}
else paramstring <- qparamstring <- nparamstring <- ""
- .mpresubs <- function(inx)
+ .mpresubs <- if(withSubst){
+ function(inx)
.presubs(inx, c("%C", "%D", "%N", "%P", "%Q", "%A"),
c(as.character(class(x)[1]),
as.character(date()),
@@ -109,7 +110,8 @@
paramstring,
qparamstring,
as.character(deparse(xc))))
-
+ }else function(inx) inx
+
xlab0 <- list("d"="x", "p"="q", "q"="p")
iL <- 1:length(to.draw)
.mp2 <- function(dlb = dots$xlab, lb0 = list("d"="x", "p"="q", "q"="p")){
@@ -370,7 +372,7 @@
col.main = par("col.main"), col.inner = par("col.main"),
col.sub = par("col.sub"), cex.points = 2.0,
pch.u = 21, pch.a = 16, mfColRow = TRUE,
- to.draw.arg = NULL){
+ to.draw.arg = NULL, withSubst = TRUE){
xc <- match.call(call = sys.call(sys.parent(1)))$x
### manipulating the ... - argument
@@ -465,14 +467,16 @@
else paramstring <- qparamstring <- nparamstring <- ""
- .mpresubs <- function(inx)
+ .mpresubs <- if(withSubst){
+ function(inx)
.presubs(inx, c("%C", "%D", "%N", "%P", "%Q", "%A"),
- c(as.character(class(x)[1]),
- as.character(date()),
- nparamstring,
- paramstring,
+ c(as.character(class(x)[1]),
+ as.character(date()),
+ nparamstring,
+ paramstring,
qparamstring,
as.character(deparse(xc))))
+ }else function(inx) inx
xlab0 <- list("d"="x", "p"="q", "q"="p")
iL <- 1:length(to.draw)
Modified: branches/distr-2.6/pkg/distr/R/plot-methods_LebDec.R
===================================================================
--- branches/distr-2.6/pkg/distr/R/plot-methods_LebDec.R 2014-12-04 19:14:13 UTC (rev 986)
+++ branches/distr-2.6/pkg/distr/R/plot-methods_LebDec.R 2015-01-15 22:46:56 UTC (rev 987)
@@ -11,7 +11,8 @@
col.hor = par("col"), col.vert = par("col"),
col.main = par("col.main"), col.inner = par("col.main"),
col.sub = par("col.sub"), cex.points = 2.0,
- pch.u = 21, pch.a = 16, mfColRow = TRUE, to.draw.arg = NULL){
+ pch.u = 21, pch.a = 16, mfColRow = TRUE, to.draw.arg = NULL,
+ withSubst = TRUE){
mc <- as.list(match.call(call = sys.call(sys.parent(1)), expand.dots = TRUE)[-1])
do.call(getMethod("plot",
@@ -30,7 +31,8 @@
col.hor = par("col"), col.vert = par("col"),
col.main = par("col.main"), col.inner = par("col.main"),
col.sub = par("col.sub"), cex.points = 2.0,
- pch.u = 21, pch.a = 16, mfColRow = TRUE, to.draw.arg = NULL){
+ pch.u = 21, pch.a = 16, mfColRow = TRUE, to.draw.arg = NULL,
+ withSubst = TRUE){
mc <- match.call(call = sys.call(sys.parent(1)), expand.dots = TRUE)[-1]
xc <- mc$x
@@ -206,7 +208,9 @@
}
else paramstring <- qparamstring <- nparamstring <- ""
- .mpresubs <- function(inx)
+
+ .mpresubs <- if(withSubst){
+ function(inx)
.presubs(inx, c("%C", "%D", "%N", "%P", "%Q", "%A"),
c(as.character(class(x)[1]),
as.character(date()),
@@ -214,6 +218,7 @@
paramstring,
qparamstring,
as.character(deparse(xc))))
+ }else function(inx)inx
.mp2 <- function(dlb = dots$xlab, lb0 = list(list("p"="q", "q"="p"),
list("d"="x", "p"="q", "q"="p"),
Modified: branches/distr-2.6/pkg/distr/R/qqplot.R
===================================================================
--- branches/distr-2.6/pkg/distr/R/qqplot.R 2014-12-04 19:14:13 UTC (rev 986)
+++ branches/distr-2.6/pkg/distr/R/qqplot.R 2015-01-15 22:46:56 UTC (rev 987)
@@ -18,16 +18,27 @@
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, debug = FALSE){
+ legend.postf = "", legend.alpha = alpha.CI, debug = FALSE, withSubst = TRUE){
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))
+ xcc <- as.character(deparse(mc$x))
+ ycc <- as.character(deparse(mc$y))
+ if(missing(xlab)) mc$xlab <- xcc
+ if(missing(ylab)) mc$ylab <- ycc
+
mcl <- as.list(mc)[-1]
mcl$withSweave <- NULL
mcl$mfColRow <- NULL
mcl$debug <- NULL
+ .mpresubs <- if(withSubst){
+ function(inx)
+ .presubs(inx, c("%C", "%A", "%D" ),
+ c(as.character(class(x)[1]),
+ as.character(date()),
+ xcc))
+ }else function(inx) inx
+
force(x)
pp <- ppoints(n)
@@ -66,6 +77,15 @@
mcl$cex <- .makeLenAndOrder(cex.pch,ord.x)
mcl$col <- .makeLenAndOrder(col.pch,ord.x)
+ mcl$xlab <- .mpresubs(mcl$xlab)
+ mcl$ylab <- .mpresubs(mcl$ylab)
+
+ if (!is.null(eval(mcl$main)))
+ mcl$main <- .mpresubs(eval(mcl$main))
+ if (!is.null(eval(mcl$sub)))
+ mcl$sub <- .mpresubs(eval(mcl$sub))
+
+
if (!withSweave){
devNew(width = width, height = height)
}
Modified: branches/distr-2.6/pkg/distr/inst/NEWS
===================================================================
--- branches/distr-2.6/pkg/distr/inst/NEWS 2014-12-04 19:14:13 UTC (rev 986)
+++ branches/distr-2.6/pkg/distr/inst/NEWS 2015-01-15 22:46:56 UTC (rev 987)
@@ -18,7 +18,11 @@
+ added generating function "EmpiricalDistribution" which is a simple
wrapper to function "DiscreteDistribution"
+ arguments panel.first, panel.last for plot-methods can now be lists
++ qqplot gains pattern substitution like plot in titles and x/y axis lables
++ pattern substitution can now be switched on and off in all plot
+ functions according to argument withSubst
+
under the hood:
-qqplot:
Modified: branches/distr-2.6/pkg/distr/man/plot-methods.Rd
===================================================================
--- branches/distr-2.6/pkg/distr/man/plot-methods.Rd 2014-12-04 19:14:13 UTC (rev 986)
+++ branches/distr-2.6/pkg/distr/man/plot-methods.Rd 2015-01-15 22:46:56 UTC (rev 987)
@@ -19,7 +19,7 @@
col.points = par("col"), col.vert = par("col"), col.main = par("col.main"),
col.inner = par("col.main"), col.sub = par("col.sub"), cex.points = 2.0,
pch.u = 21, pch.a = 16, mfColRow = TRUE,
- to.draw.arg = NULL)
+ to.draw.arg = NULL, withSubst = TRUE)
\S4method{plot}{DiscreteDistribution,missing}(x, width = 10, height = 5.5,
withSweave = getdistrOption("withSweave"), xlim = NULL, ylim = NULL,
verticals = TRUE, do.points = TRUE, main = FALSE, inner = TRUE, sub = FALSE,
@@ -28,7 +28,7 @@
col.points = par("col"), col.hor = par("col"), col.vert = par("col"),
col.main = par("col.main"), col.inner = par("col.main"),
col.sub = par("col.sub"), cex.points = 2.0, pch.u = 21, pch.a = 16,
- mfColRow = TRUE, to.draw.arg = NULL)
+ mfColRow = TRUE, to.draw.arg = NULL, withSubst = TRUE)
\S4method{plot}{AffLinUnivarLebDecDistribution,missing}(x, width = 10,
height = 5.5, withSweave = getdistrOption("withSweave"), xlim = NULL,
ylim = NULL, ngrid = 1000, verticals = TRUE, do.points = TRUE, main = FALSE,
@@ -37,7 +37,7 @@
col.points = par("col"), col.hor = par("col"), col.vert = par("col"),
col.main = par("col.main"), col.inner = par("col.main"),
col.sub = par("col.sub"), cex.points = 2.0, pch.u = 21, pch.a = 16,
- mfColRow = TRUE, to.draw.arg = NULL)
+ mfColRow = TRUE, to.draw.arg = NULL, withSubst = TRUE)
\S4method{plot}{UnivarLebDecDistribution,missing}(x, width = 10,
height = 14.5, withSweave = getdistrOption("withSweave"), xlim = NULL,
ylim = NULL, ngrid = 1000, verticals = TRUE, do.points = TRUE, main = FALSE,
@@ -46,7 +46,7 @@
col.points = par("col"), col.hor = par("col"), col.vert = par("col"),
col.main = par("col.main"), col.inner = par("col.main"),
col.sub = par("col.sub"), cex.points = 2.0, pch.u = 21, pch.a = 16,
- mfColRow = TRUE, to.draw.arg = NULL)
+ mfColRow = TRUE, to.draw.arg = NULL, withSubst = TRUE)
\S4method{plot}{DistrList,missing}(x, y, ...)
\S4method{plot}{CompoundDistribution,missing}(x, y, ...)
}
@@ -127,6 +127,8 @@
for c.d.f. and quantile function of the composed distribution and the respective
three panels for the absolutely continuous and the discrete part, respectively;
}
+ \item{withSubst}{logical; if \code{TRUE} (default) pattern substitution for
+ titles and lables is used; otherwise no substitution is used. }
\item{\dots}{addtional arguments for \code{plot} --- see
\code{\link[graphics]{plot}},
\code{\link[graphics]{plot.default}},
@@ -164,7 +166,8 @@
and a "generated on <data>"-tag in case of \code{sub}.
Of course, if \code{main} / \code{inner} / \code{sub} are \code{character}, this
is used for the title; in case of \code{inner} it is then checked whether it
-has length 3. In all title arguments, the following patterns are substituted:
+has length 3. In all title and axis label arguments, if \code{withSubst} is \code{TRUE},
+the following patterns are substituted:
\describe{
\item{\code{"\%C"}}{class of argument \code{x}}
\item{\code{"\%P"}}{parameters of \code{x} in form of a comma-separated list of
@@ -249,6 +252,9 @@
### the next ylab argument is just for illustration purposes
plot(Chisq(),mfColRow = FALSE,to.draw.arg="d",
xlab="x",ylab=list(expression(paste(lambda,"-density of \%C(\%P)"))))
+## substitution can be switched off
+plot(Chisq(),mfColRow = FALSE,to.draw.arg="d",
+ xlab="x",ylab=list(expression(paste(lambda,"-density of \%C(\%P)"))), withSubst=FALSE)
plot(Chisq(), log = "xy", ngrid = 100)
Ch <- Chisq(); setgaps(Ch); plot(Ch, do.points = FALSE)
setgaps(Ch, exactq = 3); plot(Ch, verticals = FALSE)
Modified: branches/distr-2.6/pkg/distr/man/qqplot.Rd
===================================================================
--- branches/distr-2.6/pkg/distr/man/qqplot.Rd 2014-12-04 19:14:13 UTC (rev 986)
+++ branches/distr-2.6/pkg/distr/man/qqplot.Rd 2015-01-15 22:46:56 UTC (rev 987)
@@ -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, debug = FALSE)
+ legend.postf = "", legend.alpha = alpha.CI, debug = FALSE, withSubst = TRUE)
\S4method{qqplot}{ANY,ANY}(x, y,
plot.it = TRUE, xlab = deparse(substitute(x)),
ylab = deparse(substitute(y)), ...)
@@ -80,6 +80,8 @@
\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.}
+\item{withSubst}{logical; if \code{TRUE} (default) pattern substitution for
+ titles and lables is used; otherwise no substitution is used. }
}
\description{
@@ -91,7 +93,14 @@
Graphical parameters may be given as arguments to \code{qqplot}.
The \pkg{stats} function
is just the method for signature \code{x=ANY,y=ANY}.
+ In all title and axis label arguments, if \code{withSubst} is \code{TRUE},
+ the following patterns are substituted:
+\describe{
+\item{\code{"\%C"}}{class of argument \code{x}}
+\item{\code{"\%A"}}{deparsed argument \code{x}}
+\item{\code{"\%D"}}{time/date-string when the plot was generated}
}
+}
\details{
\describe{
\item{qqplot}{\code{signature(x = "ANY", y = "ANY")}: function \code{qqplot} from
More information about the Distr-commits
mailing list