[Distr-commits] r831 - in branches/distr-2.4/pkg/distr: R man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Tue Jan 8 21:53:52 CET 2013
Author: ruckdeschel
Date: 2013-01-08 21:53:52 +0100 (Tue, 08 Jan 2013)
New Revision: 831
Modified:
branches/distr-2.4/pkg/distr/R/internalUtils.R
branches/distr-2.4/pkg/distr/R/plot-methods.R
branches/distr-2.4/pkg/distr/R/plot-methods_LebDec.R
branches/distr-2.4/pkg/distr/man/plot-methods.Rd
Log:
Taking up proposal by Baoyue Li, plot methods for distribution objects gain functionality to modify xlab and ylab
Modified: branches/distr-2.4/pkg/distr/R/internalUtils.R
===================================================================
--- branches/distr-2.4/pkg/distr/R/internalUtils.R 2013-01-07 17:16:30 UTC (rev 830)
+++ branches/distr-2.4/pkg/distr/R/internalUtils.R 2013-01-08 20:53:52 UTC (rev 831)
@@ -239,6 +239,8 @@
}
return(inC)
})
+if(length(grep("expression",inCx))>0)
+ inCx <- gsub("expression\\(", "", gsub("\\)$","",inCx))
if (length(inCx) > 1) {
inCx <- paste(inCx, c(rep(",", length(inCx)-1), ""),
sep = "", collapse = "\"\\n\",")
Modified: branches/distr-2.4/pkg/distr/R/plot-methods.R
===================================================================
--- branches/distr-2.4/pkg/distr/R/plot-methods.R 2013-01-07 17:16:30 UTC (rev 830)
+++ branches/distr-2.4/pkg/distr/R/plot-methods.R 2013-01-08 20:53:52 UTC (rev 831)
@@ -33,7 +33,7 @@
dots.for.points <- dots[names(dots) %in% c("bg", "lwd", "lty")]
if (length(dots.for.points) == 0 ) dots.for.points <- NULL
- dots.without.pch <- dots[! (names(dots) %in% c("pch", "log"))]
+ dots.without.pch <- dots[! (names(dots) %in% c("pch", "log", "xlab", "ylab"))]
if(!is(x,"AbscontDistribution"))
x <- .ULC.cast(x)
###
@@ -98,6 +98,42 @@
qparamstring,
as.character(deparse(xc))))
+ 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")){
+ dlb0 <- eval(dlb)
+ if (!is.null(dlb)){
+ .mp <- if(is.list(dlb0)) function(x,i){
+ if(is.call(x)) x <- eval(x)
+ if(length(i)==0) return(NULL)
+ i <- min(i)
+ if(is.character(x[[i]])){
+ return(as.character(eval(.mpresubs(x[[i]]))))
+ }else{
+ res <- .mpresubs(x[[i]])
+ if(length(res)==0) return(NULL)
+ if(is.call(res)) res <- res[-1]
+ return(res)}
+ }else function(x,i){
+ res <- x[i]
+ if(length(res)==0) return(NULL)
+ if(is.na(res)) return(NULL)
+ return(res)}
+ force(lb0)
+ .mp3 <- .mp(dlb,iL[to.draw==1])
+ if(1%in%to.draw & !is.null(.mp3)) lb0[["d"]] <- .mp3
+ .mp3 <- .mp(dlb,iL[to.draw==2])
+ if(2%in%to.draw & !is.null(.mp3)) lb0[["p"]] <- .mp3
+ .mp3 <- .mp(dlb,iL[to.draw==3])
+ if(3%in%to.draw & !is.null(.mp3)) lb0[["q"]] <- .mp3
+
+ }
+ return(lb0)}
+ xlab0 <- .mp2()
+ dots$xlab <- NULL
+ ylab0 <- .mp2(dlb=dots$ylab, lb0=list("d"="d(x)", "p"="p(q)", "q"="q(p)"))
+ dots$ylab <- NULL
+
if (hasArg(main)){
mainL <- TRUE
if (is.logical(main)){
@@ -199,7 +235,7 @@
if(1%in%to.draw){
on.exit(options(warn=o.warn))
do.call(plot, c(list(x = grid, dxg, type = "l",
- ylim = ylim1, ylab = "d(x)", xlab = "x", log = logpd),
+ ylim = ylim1, ylab = ylab0[["d"]], xlab = xlab0[["d"]], log = logpd),
dots.without.pch))
options(warn = o.warn)
@@ -214,7 +250,7 @@
if(2%in%to.draw){
do.call(plot, c(list(x = grid, pxg, type = "l",
- ylim = ylim2, ylab = "p(q)", xlab = "q", log = logpd),
+ ylim = ylim2, ylab = ylab0[["p"]], xlab = xlab0[["p"]], log = logpd),
dots.without.pch))
options(warn = o.warn)
@@ -254,7 +290,7 @@
if(3%in%to.draw){
options(warn = -1)
do.call(plot, c(list(x = po, xo, type = "n",
- xlim = ylim2, ylim = xlim, ylab = "q(p)", xlab = "p",
+ xlim = ylim2, ylim = xlim, ylab = ylab0[["q"]], xlab = xlab0[["q"]],
log = logq), dots.without.pch))
options(warn = o.warn)
@@ -322,14 +358,13 @@
}
l.draw <- length(to.draw)
-
dots$ngrid <- NULL
dots.for.points <- dots[names(dots) %in% c("bg", "lwd", "lty")]
if (length(dots.for.points) == 0 ) dots.for.points <- NULL
dots.without.pch <- dots[! (names(dots) %in% c("pch",
- "main", "sub", "log"))]
+ "main", "sub", "log", "xlab", "ylab"))]
###
if(!is(x,"DiscreteDistribution"))
x <- .ULC.cast(x)
@@ -390,6 +425,7 @@
}
else paramstring <- qparamstring <- nparamstring <- ""
+
.mpresubs <- function(inx)
.presubs(inx, c("%C", "%D", "%N", "%P", "%Q", "%A"),
c(as.character(class(x)[1]),
@@ -399,6 +435,42 @@
qparamstring,
as.character(deparse(xc))))
+ 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")){
+ dlb0 <- eval(dlb)
+ if (!is.null(dlb)){
+ .mp <- if(is.list(dlb0)) function(x,i){
+ if(is.call(x)) x <- eval(x)
+ if(length(i)==0) return(NULL)
+ i <- min(i)
+ if(is.character(x[[i]])){
+ return(as.character(eval(.mpresubs(x[[i]]))))
+ }else{
+ res <- .mpresubs(x[[i]])
+ if(length(res)==0) return(NULL)
+ if(is.call(res)) res <- res[-1]
+ return(res)}
+ }else function(x,i){
+ res <- x[i]
+ if(length(res)==0) return(NULL)
+ if(is.na(res)) return(NULL)
+ return(res)}
+ force(lb0)
+ .mp3 <- .mp(dlb,iL[to.draw==1])
+ if(1%in%to.draw & !is.null(.mp3)) lb0[["d"]] <- .mp3
+ .mp3 <- .mp(dlb,iL[to.draw==2])
+ if(2%in%to.draw & !is.null(.mp3)) lb0[["p"]] <- .mp3
+ .mp3 <- .mp(dlb,iL[to.draw==3])
+ if(3%in%to.draw & !is.null(.mp3)) lb0[["q"]] <- .mp3
+
+ }
+ return(lb0)}
+ xlab0 <- .mp2()
+ dots$xlab <- NULL
+ ylab0 <- .mp2(dlb=dots$ylab, lb0=list("d"="d(x)", "p"="p(q)", "q"="q(p)"))
+ dots$ylab <- NULL
+
if (hasArg(main)){
mainL <- TRUE
if (is.logical(main)){
@@ -497,7 +569,7 @@
on.exit(options(warn=o.warn))
if(1%in%to.draw){
do.call(plot, c(list(x = supp, dx, type = "h", pch = pch.a,
- ylim = ylim1, xlim=xlim, ylab = "d(x)", xlab = "x",
+ ylim = ylim1, xlim=xlim, ylab = ylab0[["d"]], xlab = xlab0[["d"]],
log = logpd), dots.without.pch))
options(warn = o.warn)
@@ -520,7 +592,7 @@
do.call(plot, c(list(x = stepfun(x = supp1, y = psupp1),
main = "", verticals = verticals,
do.points = FALSE,
- ylim = ylim2, ylab = "p(q)", xlab = "q",
+ ylim = ylim2, ylab = ylab0[["p"]], xlab = xlab0[["p"]],
col.hor = col.hor, col.vert = col.vert,
log = logpd), dots.without.pch))
if(do.points)
@@ -553,7 +625,7 @@
do.call(plot, c(list(x = stepfun(c(0,p(x)(supp)),
c(NA,supp,NA), right = TRUE),
main = "", xlim = ylim2, ylim = c(min(supp),max(supp)),
- ylab = "q(p)", xlab = "p",
+ ylab = ylab0[["q"]], xlab = xlab0[["q"]],
verticals = verticals, do.points = do.points,
cex.points = cex.points, pch = pch.a,
col.points = col.points,
Modified: branches/distr-2.4/pkg/distr/R/plot-methods_LebDec.R
===================================================================
--- branches/distr-2.4/pkg/distr/R/plot-methods_LebDec.R 2013-01-07 17:16:30 UTC (rev 830)
+++ branches/distr-2.4/pkg/distr/R/plot-methods_LebDec.R 2013-01-08 20:53:52 UTC (rev 831)
@@ -34,6 +34,7 @@
mc <- match.call(call = sys.call(sys.parent(1)), expand.dots = TRUE)[-1]
xc <- mc$x
+
### manipulating the ... - argument
dots <- match.call(call = sys.call(sys.parent(1)),
expand.dots = FALSE)$"..."
@@ -52,15 +53,20 @@
to.draw <- to.draw.arg
}
l.draw <- length(to.draw)
-
- if(!is(x, "UnivarLebDecDistribution"))
+
+ xlab0.d <- xlab0.c <- list("d"="x", "p"="q", "q"="p")
+ ylab0.d <- ylab0.c <- list("d"="d(x)", "p"="p(q)", "q"="q(p)")
+
+ if(!is(x, "UnivarLebDecDistribution"))
x <- .ULC.cast(x)
if(is(x,"DiscreteDistribution")){
mcl <- as.list(mc)
mcl$to.draw.arg <- (1:3)[( (6:8) %in%to.draw )]
mcl$ngrid <- NULL
- if(!is.logical(inner)){
+ if(is.null(mcl$xlab)) mcl$xlab <- xlab0.d
+ if(is.null(mcl$ylab)) mcl$ylab <- ylab0.d
+ if(!is.logical(inner)){
if(length(inner)!=3)
{inner <- .fillList(inner, 8)
mcl$inner <- inner[6:8]}
@@ -72,7 +78,9 @@
if(is(x,"AbscontDistribution")){
mcl <- as.list(mc)
mcl$col.hor <- NULL
- mcl$to.draw.arg <- (1:3)[( (3:5) %in%to.draw )]
+ if(is.null(mcl$xlab)) mcl$xlab <- xlab0.c
+ if(is.null(mcl$ylab)) mcl$ylab <- ylab0.c
+ mcl$to.draw.arg <- (1:3)[( (3:5) %in%to.draw )]
if(!is.logical(inner)){
if(length(inner)!=3)
{inner <- .fillList(inner, 8)
@@ -86,6 +94,8 @@
if(.isEqual(x at mixCoeff[1],0)){
x <- x at mixDistr[[2]]
mcl <- as.list(mc)
+ if(is.null(mcl$xlab)) mcl$xlab <- xlab0.d
+ if(is.null(mcl$ylab)) mcl$ylab <- ylab0.d
mcl$x <- x
mcl$to.draw.arg <- (1:3)[( (6:8) %in%to.draw )]
mcl$ngrid <- NULL
@@ -101,6 +111,8 @@
if(.isEqual(x at mixCoeff[1],1)){
x <- x at mixDistr[[1]]
mcl <- as.list(mc)
+ if(is.null(mcl$xlab)) mcl$xlab <- xlab0.c
+ if(is.null(mcl$ylab)) mcl$ylab <- ylab0.c
mcl$x <- x
mcl$to.draw.arg <- (1:3)[( (3:5) %in%to.draw )]
mcl$col.hor <- NULL
@@ -118,7 +130,7 @@
if (length(dots.for.points) == 0 ) dots.for.points <- NULL
dots.without.pch <- dots[! (names(dots) %in% c("pch",
- "main", "sub", "log"))]
+ "main", "sub", "log", "ylab", "xlab"))]
dots.for.lines <- dots.without.pch[! (names(dots.without.pch) %in% c("panel.first",
"panel.last", "ngrid", "frame.plot"))]
dots.v <- dots.for.lines
@@ -185,6 +197,59 @@
qparamstring,
as.character(deparse(xc))))
+ .mp2 <- function(dlb = dots$xlab, lb0 = list(list("p"="q", "q"="p"),
+ list("d"="x", "p"="q", "q"="p"),
+ list("d"="x", "p"="q", "q"="p"))){
+ if (!is.null(dlb)){
+ if(is.call(dlb)) dlb <- dlb[-1]
+ .mp <- if(is.list(dlb0)) function(x,i){
+ if(is.call(x)) x <- eval(x)
+ if(length(i)==0) return(NULL)
+ i <- min(i)
+ if(is.character(x[[i]])){
+ return(as.character(eval(.mpresubs(x[[i]]))))
+ }else{
+ res <- .mpresubs(x[[i]])
+ if(length(res)==0) return(NULL)
+ if(is.call(res)) res <- res[-1]
+ return(res)}
+ }else function(x,i){
+ res <- x[i]
+ if(length(res)==0) return(NULL)
+ if(is.na(res)) return(NULL)
+ return(res)}
+ force(lb0)
+ .mp3 <- .mp(dlb,iL[to.draw==1])
+ if(1%in%to.draw & !is.null(.mp3)) lb0[[1]][["p"]] <- .mp3
+ .mp3 <- .mp(dlb,iL[to.draw==2])
+ if(2%in%to.draw & !is.null(.mp3)) lb0[[1]][["q"]] <- .mp3
+ .mp3 <- .mp(dlb,iL[to.draw==3])
+ if(3%in%to.draw & !is.null(.mp3)) lb0[[2]][["d"]] <- .mp3
+ .mp3 <- .mp(dlb,iL[to.draw==4])
+ if(4%in%to.draw & !is.null(.mp3)) lb0[[2]][["p"]] <- .mp3
+ .mp3 <- .mp(dlb,iL[to.draw==5])
+ if(5%in%to.draw & !is.null(.mp3)) lb0[[2]][["q"]] <- .mp3
+ .mp3 <- .mp(dlb,iL[to.draw==6])
+ if(6%in%to.draw & !is.null(.mp3)) lb0[[3]][["d"]] <- .mp3
+ .mp3 <- .mp(dlb,iL[to.draw==7])
+ if(7%in%to.draw & !is.null(.mp3)) lb0[[3]][["p"]] <- .mp3
+ .mp3 <- .mp(dlb,iL[to.draw==8])
+ if(8%in%to.draw & !is.null(.mp3)) lb0[[3]][["q"]] <- .mp3
+ }
+ return(lb0)}
+
+ xlab0 <- .mp2()
+ xlab0.c <- xlab0[[2]]
+ xlab0.d <- xlab0[[3]]
+ dots$xlab <- NULL
+ ylab0 <- .mp2(dlb = dots$ylab, lb0 = list(list("p"="p(q)", "q"="q(p)"),
+ list("d"="d(x)", "p"="p(q)", "q"="q(p)"),
+ list("d"="d(x)", "p"="p(q)", "q"="q(p)")))
+ ylab0.c <- xlab0[[2]]
+ ylab0.d <- ylab0[[3]]
+ dots$ylab <- NULL
+
+
if (hasArg(main)){
mainL <- TRUE
if (is.logical(main)){
@@ -332,7 +397,7 @@
if(1 %in% to.draw){
on.exit(options(warn=o.warn))
do.call(plot, c(list(x = grid, pxg, type = "l",
- ylim = ylim2, ylab = "p(q)", xlab = "q", log = logpd),
+ ylim = ylim2, ylab = ylab0[[1]][["p"]], xlab = xlab0[[1]][["p"]], log = logpd),
dots.without.pch))
options(warn = o.warn)
@@ -390,7 +455,7 @@
if(2 %in% to.draw){
options(warn = -1)
do.call(plot, c(list(x = po, xo, type = "n",
- xlim = ylim2, ylim = xlim, ylab = "q(p)", xlab = "p",
+ xlim = ylim2, ylim = xlim, ylab = ylab0[[1]][["q"]], xlab = xlab0[[1]][["q"]],
log = logq), dots.without.pch), envir = parent.frame(2))
options(warn = o.warn)
@@ -445,6 +510,8 @@
if(is.character(x))
as.character(eval(.mpresubs(x)))
else .mpresubs(x))
+ mc.ac$xlab <- xlab0.c
+ mc.ac$ylab <- ylab0.c
mc.ac$mfColRow <- FALSE
mc.ac$main <- FALSE
mc.ac$sub <- FALSE
@@ -460,6 +527,8 @@
if(is.character(x))
as.character(eval(.mpresubs(x)))
else .mpresubs(x))
+ mc.di$xlab <- xlab0.d
+ mc.di$ylab <- ylab0.d
mc.di$mfColRow <- FALSE
mc.di$main <- FALSE
mc.di$sub <- FALSE
Modified: branches/distr-2.4/pkg/distr/man/plot-methods.Rd
===================================================================
--- branches/distr-2.4/pkg/distr/man/plot-methods.Rd 2013-01-07 17:16:30 UTC (rev 830)
+++ branches/distr-2.4/pkg/distr/man/plot-methods.Rd 2013-01-08 20:53:52 UTC (rev 831)
@@ -189,7 +189,21 @@
If not explicitly set, \code{cex} is set to 1. If not explicitly set,
\code{cex.points} is set to $2.0 \code{cex}$ (if \code{cex} is given)
-and to 2.0 else.
+and to 2.0 else.
+
+If general \code{plot} arguments \code{xlab}, \code{ylab} are not specified,
+they are set to \code{"x"}, \code{"q"}, \code{"p"} for \code{xlab} and
+to \code{"d(x)"}, \code{"p(q)"}, \code{"q(p)"} for \code{ylab} for
+density, cdf and quantile function respectively.
+Otherwise, according to the respective content of \code{to.draw.arg},
+it is supposed to be a list with one entry for each selected panel, i.e.,
+in case \code{x} is an object of class \code{DiscreteDistribution} or
+\code{AbscontDistribution} a list of maximal length maximally 3, respectively,
+in case \code{x} is an object of class \code{UnivarLebDecDistribution}
+In these label arguments, the same pattern substitutions are made as
+for titles. If no character substitutions and mathematical expressions
+are needed, character vectors of respective length instead of lists are
+also allowed for arguments \code{xlab}, \code{ylab}.
}
\examples{
@@ -199,6 +213,8 @@
plot(Binom(size = 4, prob = 0.3), main = TRUE)
plot(Binom(size = 4, prob = 0.3), main = FALSE)
plot(Binom(size = 4, prob = 0.3), cex.points = 1.2, pch = 20)
+plot(Binom(size = 4, prob = 0.3), xlab = list("a1","a2", "a3"),
+ ylab=list("p"="U","q"="V","d"="W"))
B <- Binom(size = 4, prob = 0.3)
plot(B, col = "red", col.points = "green", main = TRUE, col.main = "blue",
col.sub = "orange", sub = TRUE, cex.sub = 0.6, col.inner = "brown")
@@ -216,6 +232,9 @@
plot(Cauchy())
plot(Cauchy(), xlim = c(-4,4))
plot(Chisq())
+### 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)"))))
plot(Chisq(), log = "xy", ngrid = 100)
Ch <- Chisq(); setgaps(Ch); plot(Ch, do.points = FALSE)
setgaps(Ch, exactq = 3); plot(Ch, verticals = FALSE)
@@ -248,6 +267,9 @@
P <- Pois(2)
plot(as(P,"UnivarLebDecDistribution"),mfColRow = FALSE,to.draw.arg=c("d.d"))
+### the next ylab argument is just for illustration purposes
+plot(as(P,"UnivarLebDecDistribution"),mfColRow = FALSE,to.draw.arg=c("d.d"),
+ xlab="x",ylab=list(expression(paste(lambda,"-density of \%C(\%P)"))))
}
\seealso{\code{\link[graphics]{plot}},\code{\link[graphics]{plot.default}},
More information about the Distr-commits
mailing list