[Distr-commits] r964 - in branches/distr-2.6/pkg/distr: R inst man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Tue Aug 19 02:11:33 CEST 2014
Author: ruckdeschel
Date: 2014-08-19 02:11:33 +0200 (Tue, 19 Aug 2014)
New Revision: 964
Modified:
branches/distr-2.6/pkg/distr/R/internalUtils.R
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/inst/NEWS
branches/distr-2.6/pkg/distr/man/internals.Rd
branches/distr-2.6/pkg/distr/man/plot-methods.Rd
Log:
[distr] arguments panel.first, panel.last for plot-methods can now be lists; still does not work quite as desired (see example (plot))
Modified: branches/distr-2.6/pkg/distr/R/internalUtils.R
===================================================================
--- branches/distr-2.6/pkg/distr/R/internalUtils.R 2014-08-18 21:13:32 UTC (rev 963)
+++ branches/distr-2.6/pkg/distr/R/internalUtils.R 2014-08-19 00:11:33 UTC (rev 964)
@@ -1272,4 +1272,18 @@
}
-
\ No newline at end of file
+.panel.mingle <- function(dots, element){
+ pF <- dots[[element]]
+ if(is.list(pF)) return(pF)
+ pFr <- if(typeof(pF)=="symbol") eval(pF) else{
+ pFc <- as.call(pF)
+ if(as.list(pFc)[[1]] == "list"){
+ lis <- vector("list",length(as.list(pFc))-1)
+ for(i in 1:length(lis)){
+ lis[[i]] <- pFc[[i+1]]
+ }
+ lis
+ }else pF
+ }
+ return(pFr)
+}
Modified: branches/distr-2.6/pkg/distr/R/plot-methods.R
===================================================================
--- branches/distr-2.6/pkg/distr/R/plot-methods.R 2014-08-18 21:13:32 UTC (rev 963)
+++ branches/distr-2.6/pkg/distr/R/plot-methods.R 2014-08-19 00:11:33 UTC (rev 964)
@@ -28,6 +28,18 @@
l.draw <- length(to.draw)
+ pF <- expression({})
+ if(!is.null(dots[["panel.first"]])){
+ pF <- .panel.mingle(dots,"panel.first")
+ }
+ pF <- .fillList(pF, l.draw)
+ pL <- expression({})
+ if(!is.null(dots[["panel.last"]])){
+ pL <- .panel.mingle(dots,"panel.last")
+ }
+ pL <- .fillList(pL, l.draw)
+
+ dots$panel.first <- dots$panel.last <- NULL
dots$col.hor <- NULL
dots.for.points <- .makedotsPt(dots)
@@ -231,12 +243,17 @@
}
}
+ plotCount <- 1
o.warn <- getOption("warn"); options(warn = -1)
if(1%in%to.draw){
on.exit(options(warn=o.warn))
- do.call(plot, c(list(x = grid, dxg, type = "l",
+ dots.without.pch$panel.first <- pF[[plotCount]]
+ dots.without.pch$panel.last <- pL[[plotCount]]
+ do.call(plot, c(list(x = grid, dxg, type = "l",
ylim = ylim1, ylab = ylab0[["d"]], xlab = xlab0[["d"]], log = logpd),
dots.without.pch))
+ dots.without.pch$panel.first <- dots.without.pch$panel.last <- NULL
+ plotCount <- plotCount + 1
options(warn = o.warn)
title(main = inner.d, line = lineT, cex.main = cex.inner,
@@ -249,9 +266,13 @@
if(is.finite(q(x)(1))) {grid <- c(grid,q(x)(1)); pxg <- c(pxg,1)}
if(2%in%to.draw){
- do.call(plot, c(list(x = grid, pxg, type = "l",
+ dots.without.pch$panel.first <- pF[[plotCount]]
+ dots.without.pch$panel.last <- pL[[plotCount]]
+ do.call(plot, c(list(x = grid, pxg, type = "l",
ylim = ylim2, ylab = ylab0[["p"]], xlab = xlab0[["p"]], log = logpd),
dots.without.pch))
+ dots.without.pch$panel.first <- dots.without.pch$panel.last <- NULL
+ plotCount <- plotCount + 1
options(warn = o.warn)
title(main = inner.p, line = lineT, cex.main = cex.inner,
@@ -289,9 +310,13 @@
if(3%in%to.draw){
options(warn = -1)
- do.call(plot, c(list(x = po, xo, type = "n",
+ dots.without.pch$panel.first <- pF[[plotCount]]
+ dots.without.pch$panel.last <- pL[[plotCount]]
+ do.call(plot, c(list(x = po, xo, type = "n",
xlim = ylim2, ylim = xlim, ylab = ylab0[["q"]], xlab = xlab0[["q"]],
log = logq), dots.without.pch))
+ dots.without.pch$panel.first <- dots.without.pch$panel.last <- NULL
+ plotCount <- plotCount + 1
options(warn = o.warn)
@@ -358,10 +383,21 @@
}
l.draw <- length(to.draw)
+ pF <- expression({})
+ if(!is.null(dots[["panel.first"]])){
+ pF <- .panel.mingle(dots,"panel.first")
+ }
+ pF <- .fillList(pF, l.draw)
+ pL <- expression({})
+ if(!is.null(dots[["panel.last"]])){
+ pL <- .panel.mingle(dots,"panel.last")
+ }
+ pL <- .fillList(pL, l.draw)
+ dots$panel.first <- dots$panel.last <- NULL
+
dots$ngrid <- NULL
dots.for.points <- .makedotsPt(dots)
- print(dots.for.points)
dots.lowlevel <- .makedotsLowLevel(dots)
dots.without.pch <- dots.lowlevel[! (names(dots.lowlevel) %in% c("col", "pch"))]
###
@@ -566,10 +602,17 @@
o.warn <- getOption("warn")
options(warn = -1)
on.exit(options(warn=o.warn))
+
+ plotCount <- 1
+
if(1%in%to.draw){
+ dots.without.pch$panel.first <- pF[[plotCount]]
+ dots.without.pch$panel.last <- pL[[plotCount]]
do.call(plot, c(list(x = supp, dx, type = "h", pch = pch.a,
ylim = ylim1, xlim=xlim, ylab = ylab0[["d"]], xlab = xlab0[["d"]],
log = logpd), dots.without.pch))
+ dots.without.pch$panel.first <- dots.without.pch$panel.last <- NULL
+ plotCount <- plotCount + 1
options(warn = o.warn)
@@ -588,12 +631,16 @@
psupp1 <- c(0,p(x)(supp1))
if(2%in%to.draw){
- do.call(plot, c(list(x = stepfun(x = supp1, y = psupp1),
+ dots.without.pch$panel.first <- pF[[plotCount]]
+ dots.without.pch$panel.last <- pL[[plotCount]]
+ do.call(plot, c(list(x = stepfun(x = supp1, y = psupp1),
main = "", verticals = verticals,
do.points = FALSE,
ylim = ylim2, ylab = ylab0[["p"]], xlab = xlab0[["p"]],
col.hor = col.hor, col.vert = col.vert,
log = logpd), dots.without.pch))
+ dots.without.pch$panel.first <- dots.without.pch$panel.last <- NULL
+ plotCount <- plotCount + 1
if(do.points)
{if(ngrid>1){
do.call(points, c(list(x = supp, y = psupp1[1:ngrid], pch = pch.u,
@@ -621,7 +668,9 @@
if(3%in%to.draw){
options(warn = -1)
- do.call(plot, c(list(x = stepfun(c(0,p(x)(supp)),
+ dots.without.pch$panel.first <- pF[[plotCount]]
+ dots.without.pch$panel.last <- pL[[plotCount]]
+ 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 = ylab0[["q"]], xlab = xlab0[["q"]],
@@ -630,6 +679,8 @@
col.points = col.points,
col.hor = col.hor, col.vert = col.vert,
log = logq), dots.without.pch))
+ dots.without.pch$panel.first <- dots.without.pch$panel.last <- NULL
+ plotCount <- plotCount + 1
options(warn = o.warn)
Modified: branches/distr-2.6/pkg/distr/R/plot-methods_LebDec.R
===================================================================
--- branches/distr-2.6/pkg/distr/R/plot-methods_LebDec.R 2014-08-18 21:13:32 UTC (rev 963)
+++ branches/distr-2.6/pkg/distr/R/plot-methods_LebDec.R 2014-08-19 00:11:33 UTC (rev 964)
@@ -57,6 +57,19 @@
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)")
+ pF <<- expression({})
+ if(!is.null(dots[["panel.first"]])){
+ pF <<- .panel.mingle(dots,"panel.first")
+ }
+ pF <<- .fillList(pF, l.draw)
+ pL <<- expression({})
+ if(!is.null(dots[["panel.last"]])){
+ pL <<- .panel.mingle(dots,"panel.last")
+ }
+ pL <<- .fillList(pL, l.draw)
+ dots$panel.first <- dots$panel.last <- NULL
+
+ plotCount <- 1
if(!is(x, "UnivarLebDecDistribution"))
x <- .ULC.cast(x)
@@ -64,6 +77,8 @@
mcl <- as.list(mc)
mcl$to.draw.arg <- (1:3)[( (6:8) %in%to.draw )]
mcl$ngrid <- NULL
+ mcl$panel.first <- pF[plotCount+(0:2)]
+ mcl$panel.last <- pL[plotCount+(0:2)]
if(is.null(mcl$xlab)) mcl$xlab <- xlab0.d
if(is.null(mcl$ylab)) mcl$ylab <- ylab0.d
if(!is.logical(inner)){
@@ -80,6 +95,8 @@
mcl$col.hor <- NULL
if(is.null(mcl$xlab)) mcl$xlab <- xlab0.c
if(is.null(mcl$ylab)) mcl$ylab <- ylab0.c
+ mcl$panel.first <- pF[plotCount+(0:2)]
+ mcl$panel.last <- pL[plotCount+(0:2)]
mcl$to.draw.arg <- (1:3)[( (3:5) %in%to.draw )]
if(!is.logical(inner)){
if(length(inner)!=3)
@@ -99,6 +116,8 @@
mcl$x <- x
mcl$to.draw.arg <- (1:3)[( (6:8) %in%to.draw )]
mcl$ngrid <- NULL
+ mcl$panel.first <- pF[5+mcl$to.draw.arg]
+ mcl$panel.last <- pL[5+mcl$to.draw.arg]
if(!is.logical(inner)){
if(length(inner)!=3)
{inner <- .fillList(inner, 8)
@@ -116,6 +135,8 @@
mcl$x <- x
mcl$to.draw.arg <- (1:3)[( (3:5) %in%to.draw )]
mcl$col.hor <- NULL
+ mcl$panel.first <- pF[2+mcl$to.draw.arg]
+ mcl$panel.last <- pL[2+mcl$to.draw.arg]
if(!is.logical(inner)){
if(length(inner)!=3)
{inner <- .fillList(inner, 8)
@@ -393,9 +414,13 @@
o.warn <- getOption("warn"); options(warn = -1)
if(1 %in% to.draw){
on.exit(options(warn=o.warn))
+ dots.without.pch$panel.first <- pF[[plotCount]]
+ dots.without.pch$panel.last <- pL[[plotCount]]
do.call(plot, c(list(x = grid, pxg, type = "l",
ylim = ylim2, ylab = ylab0[[1]][["p"]], xlab = xlab0[[1]][["p"]], log = logpd),
dots.without.pch))
+ dots.without.pch$panel.first <- dots.without.pch$panel.last <- NULL
+ plotCount <- plotCount + 1
options(warn = o.warn)
pxg.d <- p(x)(supp)
@@ -451,9 +476,13 @@
if(2 %in% to.draw){
options(warn = -1)
+ dots.without.pch$panel.first <- pF[[plotCount]]
+ dots.without.pch$panel.last <- pL[[plotCount]]
do.call(plot, c(list(x = po, xo, type = "n",
xlim = ylim2, ylim = xlim, ylab = ylab0[[1]][["q"]], xlab = xlab0[[1]][["q"]],
log = logq), dots.without.pch), envir = parent.frame(2))
+ plotCount <- plotCount + 1
+ dots.without.pch$panel.first <- dots.without.pch$panel.last <- NULL
options(warn = o.warn)
@@ -516,7 +545,10 @@
mc.ac$withSweave <- TRUE
mc.ac$to.draw.arg <- (1:3)[( (3:5) %in%to.draw )]
if(is.null(mc.ac$cex.inner)) mc.ac$cex.inner <- 0.9
+ mc.ac[["panel.first"]] <- pF[plotCount+(0:2)]
+ mc.ac[["panel.last"]] <- pL[plotCount+(0:2)]
do.call(plotC, c(list(acPart(x)),mc.ac), envir = parent.frame(2))
+ plotCount <- plotCount + 3
mc.di <- mc
if(!is.logical(inner))
@@ -534,7 +566,10 @@
mc.di$withSweave <- TRUE
mc.di$to.draw.arg <- (1:3)[( (6:8) %in%to.draw )]
if(is.null(mc.di$cex.inner)) mc.di$cex.inner <- 0.9
+ mc.di[["panel.first"]] <- pF[plotCount+(0:2)]
+ mc.di[["panel.last"]] <- pL[plotCount+(0:2)]
do.call(plotD, c(list(discretePart(x)),mc.di), envir = parent.frame(2))
+ plotCount <- plotCount + 3
return(invisible())
}
Modified: branches/distr-2.6/pkg/distr/inst/NEWS
===================================================================
--- branches/distr-2.6/pkg/distr/inst/NEWS 2014-08-18 21:13:32 UTC (rev 963)
+++ branches/distr-2.6/pkg/distr/inst/NEWS 2014-08-19 00:11:33 UTC (rev 964)
@@ -16,7 +16,8 @@
+ updated references in vignette 'newDistributions'
+ added generating function "EmpiricalDistribution" which is a simple
wrapper to function "DiscreteDistribution"
-
++ arguments panel.first, panel.last for plot-methods can now be lists
+
under the hood:
-qqplot:
Modified: branches/distr-2.6/pkg/distr/man/internals.Rd
===================================================================
--- branches/distr-2.6/pkg/distr/man/internals.Rd 2014-08-18 21:13:32 UTC (rev 963)
+++ branches/distr-2.6/pkg/distr/man/internals.Rd 2014-08-19 00:11:33 UTC (rev 964)
@@ -59,6 +59,7 @@
\alias{.DistrCollapse}
\alias{.convDiscrDiscr}
\alias{.inWithTol}
+\alias{.panel.mingle}
\alias{devNew}
\title{Internal functions of package distr}
@@ -134,6 +135,7 @@
.getCommonWidth(x1,x2, tol=.Machine$double.eps)
.convDiscrDiscr(e1,e2)
.inWithTol(x,y,tol=.Machine$double.eps)
+.panel.mingle(dots,element)
devNew(...)
}
@@ -241,6 +243,8 @@
\item{n2}{integer argument for \code{.EuclidAlgo}}
\item{x1}{width argument for \code{.getCommonWidth}}
\item{x2}{width argument for \code{.getCommonWidth}}
+ \item{dots}{the unevaluated \code{\dots} argument}
+ \item{element}{the name of the item in the unevaluated \code{\dots} argument}
\item{...}{arguments passed through to other functions}
}
@@ -392,6 +396,13 @@
\code{.convDiscrDiscr} computes the convolution of two discrete distributions by
brute force.
\code{.inWithTol} works like \code{\%in\%} but with a given tolerance.
+
+\code{.panel.mingle} is used for mingling arguments \code{panel.first},
+\code{panel.last} in a plot; it returns the evaluated argument \code{element}
+within dots, if it is a symbol; else if it can be interpreted as a call, and if
+the top call is \code{list}, it returns a list of the items of the call to \code{list},
+unevaluated, and otherwise the unchanged argument.
+
\code{devNew} opens a new device. This function is for back compatibility
with R versions < 2.8.0.
}
@@ -464,7 +475,12 @@
\item{.convDiscrDiscr}{returns the convolution of two discrete distributions.}
\item{.inWithTol}{returns a logical vector of same lenght as \code{x} for the
matches (up to tolerance) with vector \code{y}.}
-\item{devNew}{returns the return value of the device opened,
+\item{.panel.mingle}{used for mingling arguments \code{panel.first},
+\code{panel.last}; returns the evaluated argument \code{element} within dots,
+if it is a symbol; else if it can be interpreted as a call, and if the top
+call is \code{list}, it returns a list of the items of the call to \code{list},
+unevaluated, and otherwise the unchanged argument.}
+\item{devNew}{returns the return value of the device opened,
usually invisible \code{NULL}.}
}
Modified: branches/distr-2.6/pkg/distr/man/plot-methods.Rd
===================================================================
--- branches/distr-2.6/pkg/distr/man/plot-methods.Rd 2014-08-18 21:13:32 UTC (rev 963)
+++ branches/distr-2.6/pkg/distr/man/plot-methods.Rd 2014-08-19 00:11:33 UTC (rev 964)
@@ -204,6 +204,13 @@
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}.
+
+In addition, argument \code{\dots} may contain arguments \code{panel.first},
+\code{panel.last}, i.e., hook expressions to be evaluated at the very beginning
+and at the very end of each panel (within the then valid coordinates).
+To be able to use these hooks for each panel individually, they may also be
+lists of expressions (of the same length as the number of panels and
+run through in the same order as the panels).
}
\examples{
@@ -229,6 +236,13 @@
"Pseudo-inverse with param's \%N"),
sub = "this plot was correctly generated on \%D",
cex.inner = 0.9, cex.sub = 0.8)
+
+plot(Norm(),panel.first=grid(4,4))
+## does not (yet) work as desired:
+plot(Norm(),panel.first=list(grid(5,5),grid(3,3),grid(4,4)))
+li <- list(substitute(grid(5,5)),substitute(grid(3,3)),substitute(grid(4,4)))
+plot(Norm(),panel.first=li)
+
plot(Cauchy())
plot(Cauchy(), xlim = c(-4,4))
plot(Chisq())
More information about the Distr-commits
mailing list