[Distr-commits] r1198 - in branches/distr-2.8/pkg/distr: R man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Thu Jul 12 18:30:06 CEST 2018
Author: ruckdeschel
Date: 2018-07-12 18:30:06 +0200 (Thu, 12 Jul 2018)
New Revision: 1198
Modified:
branches/distr-2.8/pkg/distr/R/plot-methods.R
branches/distr-2.8/pkg/distr/R/plot-methods_LebDec.R
branches/distr-2.8/pkg/distr/R/qqplot.R
branches/distr-2.8/pkg/distr/man/plot-methods.Rd
Log:
[distr] branch 2.8: plot methods now return an S3 object of class \code{c("plotInfo","DiagnInfo")}, i.e., a list containing the
information needed to produce the respective plot, which at a later stage could be used by different graphic engines (like, e.g.
\code{ggplot}) to produce the plot in a different framework. A more detailed description will follow in a subsequent version.
Modified: branches/distr-2.8/pkg/distr/R/plot-methods.R
===================================================================
--- branches/distr-2.8/pkg/distr/R/plot-methods.R 2018-07-11 17:44:44 UTC (rev 1197)
+++ branches/distr-2.8/pkg/distr/R/plot-methods.R 2018-07-12 16:30:06 UTC (rev 1198)
@@ -12,9 +12,10 @@
cex.points = 2.0, pch.u = 21, pch.a = 16, mfColRow = TRUE,
to.draw.arg = NULL, withSubst = TRUE){
- xc <- match.call(call = sys.call(sys.parent(1)))$x
+ mc <- match.call(call = sys.call(sys.parent(1)))
+ xc <- mc$x
### manipulating the ... - argument
- dots <- match.call(call = sys.call(sys.parent(1)),
+ dots <- match.call(call = sys.call(sys.parent(1)),
expand.dots = FALSE)$"..."
to.draw <- 1:3
@@ -246,6 +247,23 @@
}
}
+ plotInfo <- list(call = mc, dots=dots,
+ args = list(width = width, height = height,
+ withSweave = withSweave,
+ xlim = xlim, ylim = ylim, ngrid = ngrid,
+ verticals = verticals, do.points = do.points,
+ main = main, inner = inner, sub = sub,
+ bmar = bmar, tmar = tmar, cex.main = cex.main,
+ cex.inner = cex.inner, cex.sub = cex.sub,
+ col.points = col.points, col.vert = col.vert,
+ col.main = col.main, col.inner = col.inner,
+ col.sub = col.sub, cex.points = cex.points,
+ pch.u = pch.u, pch.a = pch.a, mfColRow = mfColRow,
+ to.draw.arg = to.draw.arg, withSubst = withSubst),
+ to.draw=to.draw, panelFirst = pF,
+ panelLast = pL)
+
+
plotCount <- 1
o.warn <- getOption("warn"); options(warn = -1)
if(1%in%to.draw){
@@ -253,14 +271,21 @@
dots.lowlevel$panel.first <- pF[[plotCount]]
dots.lowlevel$panel.last <- pL[[plotCount]]
dots.lowlevel$xlim <- xlim
+ plotInfo$dplot$plot <- c(list(x = grid, dxg, type = "l",
+ ylim = ylim1, ylab = ylab0[["d"]], xlab = xlab0[["d"]], log = logpd),
+ dots.lowlevel)
do.call(plot, c(list(x = grid, dxg, type = "l",
ylim = ylim1, ylab = ylab0[["d"]], xlab = xlab0[["d"]], log = logpd),
dots.lowlevel))
+ plotInfo$dplot$usr <- par("usr")
dots.lowlevel$panel.first <- dots.lowlevel$panel.last <- NULL
dots.lowlevel$xlim <- NULL
plotCount <- plotCount + 1
options(warn = o.warn)
+ plotInfo$dplot$title <- list(main = inner.d, line = lineT,
+ cex.main = cex.inner, col.main = col.inner)
+
title(main = inner.d, line = lineT, cex.main = cex.inner,
col.main = col.inner)
@@ -274,14 +299,20 @@
dots.lowlevel$panel.first <- pF[[plotCount]]
dots.lowlevel$panel.last <- pL[[plotCount]]
dots.lowlevel$xlim <- xlim
+ plotInfo$pplot$plot <- c(list(x = grid, pxg, type = "l",
+ ylim = ylim2, ylab = ylab0[["p"]], xlab = xlab0[["p"]], log = logpd),
+ dots.lowlevel)
do.call(plot, c(list(x = grid, pxg, type = "l",
ylim = ylim2, ylab = ylab0[["p"]], xlab = xlab0[["p"]], log = logpd),
dots.lowlevel))
+ plotInfo$pplot$usr <- par("usr")
dots.lowlevel$panel.first <- dots.lowlevel$panel.last <- NULL
dots.lowlevel$xlim <- NULL
plotCount <- plotCount + 1
options(warn = o.warn)
-
+ plotInfo$pplot$title <- list(main = inner.p, line = lineT,
+ cex.main = cex.inner, col.main = col.inner)
+
title(main = inner.p, line = lineT, cex.main = cex.inner,
col.main = col.inner)
}
@@ -319,14 +350,20 @@
options(warn = -1)
dots.lowlevel$panel.first <- pF[[plotCount]]
dots.lowlevel$panel.last <- pL[[plotCount]]
+ plotInfo$qplot$plot <- c(list(x = po, xo, type = "n",
+ xlim = ylim2, ylim = xlim, ylab = ylab0[["q"]], xlab = xlab0[["q"]],
+ log = logq), dots.lowlevel)
do.call(plot, c(list(x = po, xo, type = "n",
xlim = ylim2, ylim = xlim, ylab = ylab0[["q"]], xlab = xlab0[["q"]],
log = logq), dots.lowlevel))
+ plotInfo$qplot$usr <- par("usr")
dots.lowlevel$panel.first <- dots.lowlevel$panel.last <- NULL
plotCount <- plotCount + 1
options(warn = o.warn)
+ plotInfo$qplot$title <- list(main = inner.q, line = lineT,
+ cex.main = cex.inner, col.main = col.inner)
title(main = inner.q, line = lineT, cex.main = cex.inner,
col.main = col.inner)
@@ -340,6 +377,8 @@
dots.without.pch0$col <- NULL
do.call(lines, c(list(pu[o], xu[o],
col = col.vert), dots.without.pch0))
+ plotInfo$qplot$vlines <- c(list(x=pu[o], y=xu[o],
+ col = col.vert), dots.without.pch0)
}
options(warn = o.warn)
@@ -348,16 +387,28 @@
cex = cex.points, col = col.points), dots.for.points) )
do.call(points, c(list(x = pu1, y = gaps(x)[,2], pch = pch.u,
cex = cex.points, col = col.points), dots.for.points) )
+ plotInfo$qplot$vpoints.l <- c(list(x=pu1, y=gaps(x)[,1],
+ pch = pch.a, cex = cex.points, col = col.points),
+ dots.for.points)
+ plotInfo$qplot$vpoints.r <- c(list(x=pu1, y=gaps(x)[,2],
+ pch = pch.a, cex = cex.points, col = col.points),
+ dots.for.points)
}
}
- if (mainL)
+ if (mainL){
mtext(text = main, side = 3, cex = cex.main, adj = .5,
outer = TRUE, padj = 1.4, col = col.main)
-
- if (subL)
+ plotInfo$mainL <- list(text = main, side = 3, cex = cex.main, adj = .5,
+ outer = TRUE, padj = 1.4, col = col.main)
+ }
+ if (subL){
mtext(text = sub, side = 1, cex = cex.sub, adj = .5,
outer = TRUE, line = -1.6, col = col.sub)
- return(invisible())
+ plotInfo$subL <- list(text = sub, side = 1, cex = cex.sub, adj = .5,
+ outer = TRUE, line = -1.6, col = col.sub)
+ }
+ class(plotInfo) <- c("plotInfo","DiagnInfo")
+ return(invisible(plotInfo))
}
)
# -------- DiscreteDistribution -------- #
@@ -375,11 +426,25 @@
pch.u = 21, pch.a = 16, mfColRow = TRUE,
to.draw.arg = NULL, withSubst = TRUE){
- xc <- match.call(call = sys.call(sys.parent(1)))$x
+ mc <- match.call(call = sys.call(sys.parent(1)))
+ xc <- mc$x
### manipulating the ... - argument
dots <- match.call(call = sys.call(sys.parent(1)),
expand.dots = FALSE)$"..."
+ plotInfo <- list(call = mc, dots=dots,
+ args = list(width = width, height = height,
+ withSweave = withSweave,
+ xlim = xlim, ylim = ylim, verticals = verticals,
+ do.points = do.points, main = main, inner = inner,
+ sub = sub, bmar = bmar, tmar = tmar, cex.main = cex.main,
+ cex.inner = cex.inner, cex.sub = cex.sub,
+ col.points = col.points, col.hor = col.hor,
+ col.vert = col.vert, col.main = col.main,
+ col.inner = col.inner, col.sub = col.sub,
+ cex.points = cex.points, pch.u = pch.u,
+ pch.a = pch.a, mfColRow = mfColRow,
+ to.draw.arg = to.draw.arg, withSubst = withSubst))
to.draw <- 1:3
names(to.draw) <- c("d","p","q")
if(! is.null(to.draw.arg)){
@@ -400,6 +465,11 @@
pL <- .panel.mingle(dots,"panel.last")
}
pL <- .fillList(pL, l.draw)
+
+ plotInfo$to.draw <- to.draw
+ plotInfo$panelFirst <- pF
+ plotInfo$panelLast <- pL
+
dots$panel.first <- dots$panel.last <- NULL
dots$ngrid <- NULL
@@ -618,9 +688,13 @@
if(1%in%to.draw){
dots.without.pch$panel.first <- pF[[plotCount]]
dots.without.pch$panel.last <- pL[[plotCount]]
+ plotInfo$dplot$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)
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))
+ plotInfo$dplot$usr <- par("usr")
dots.without.pch$panel.first <- dots.without.pch$panel.last <- NULL
plotCount <- plotCount + 1
options(warn = o.warn)
@@ -628,11 +702,15 @@
title(main = inner.d, line = lineT, cex.main = cex.inner,
col.main = col.inner)
+ plotInfo$dplot$title <- list(main = inner.d, line = lineT,
+ cex.main = cex.inner, col.main = col.inner)
if(do.points)
- do.call(points, c(list(x = supp, y = dx, pch = pch.a,
+ do.call(points, c(list(x = supp, y = dx, pch = pch.a,
cex = cex.points, col = col.points), dots.for.points))
-
+ plotInfo$dplot$points <- c(list(x = supp, y = dx, pch = pch.a,
+ cex = cex.points, col = col.points), dots.for.points)
+
options(warn = -1)
}
ngrid <- length(supp)
@@ -643,12 +721,19 @@
if(2%in%to.draw){
dots.without.pch$panel.first <- pF[[plotCount]]
dots.without.pch$panel.last <- pL[[plotCount]]
+ plotInfo$pplot$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)
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))
+ plotInfo$pplot$usr <- par("usr")
dots.without.pch$panel.first <- dots.without.pch$panel.last <- NULL
plotCount <- plotCount + 1
if(do.points)
@@ -657,11 +742,19 @@
cex = cex.points, col = col.points), dots.for.points))
do.call(points, c(list(x = supp, y = psupp1[2:(ngrid+1)], pch = pch.a,
cex = cex.points, col = col.points), dots.for.points))
+ plotInfo$pplot$points.u <- c(list(x = supp, y = psupp1[1:ngrid], pch = pch.u,
+ cex = cex.points, col = col.points), dots.for.points)
+ plotInfo$pplot$points.a <- c(list(x = supp, y = psupp1[2:(ngrid+1)], pch = pch.a,
+ cex = cex.points, col = col.points), dots.for.points)
}else{
do.call(points, c(list(x = supp, y = 0, pch = pch.u,
cex = cex.points, col = col.points), dots.for.points))
do.call(points, c(list(x = supp, y = 1, pch = pch.a,
cex = cex.points, col = col.points), dots.for.points))
+ plotInfo$pplot$points.u <- c(list(x = supp, y = 0, pch = pch.u,
+ cex = cex.points, col = col.points), dots.for.points)
+ plotInfo$pplot$points.a <- c(list(x = supp, y = 1, pch = pch.a,
+ cex = cex.points, col = col.points), dots.for.points)
}
}
options(warn = o.warn)
@@ -669,17 +762,33 @@
title(main = inner.p, line = lineT, cex.main = cex.inner,
col.main = col.inner)
+ plotInfo$pplot$title <- c(main = inner.p, line = lineT,
+ cex.main = cex.inner, col.main = col.inner)
- if(do.points)
+
+ if(do.points){
do.call(points, c(list(x = supp,
y = c(0,p(x)(supp[-length(supp)])), pch = pch.u,
cex = cex.points, col = col.points), dots.for.points))
- }
+ plotInfo$pplot$points <- c(list(x = supp,
+ y = c(0,p(x)(supp[-length(supp)])), pch = pch.u,
+ cex = cex.points, col = col.points), dots.for.points)
+ }
+ }
if(3%in%to.draw){
options(warn = -1)
dots.without.pch$panel.first <- pF[[plotCount]]
dots.without.pch$panel.last <- pL[[plotCount]]
+ plotInfo$qplot$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"]],
+ verticals = verticals, do.points = do.points,
+ cex.points = cex.points, pch = pch.a,
+ col.points = col.points,
+ col.hor = col.hor, col.vert = col.vert,
+ log = logq), dots.without.pch)
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)),
@@ -689,6 +798,7 @@
col.points = col.points,
col.hor = col.hor, col.vert = col.vert,
log = logq), dots.without.pch))
+ plotInfo$qplot$usr <- par("usr")
dots.without.pch$panel.first <- dots.without.pch$panel.last <- NULL
plotCount <- plotCount + 1
options(warn = o.warn)
@@ -696,19 +806,29 @@
title(main = inner.q, line = lineT, cex.main = cex.inner,
col.main = col.inner)
+ plotInfo$qplot$title <- c(main = inner.q, line = lineT,
+ cex.main = cex.inner, col.main = col.inner)
dots.without.pch0 <- dots.without.pch
dots.without.pch0$col <- NULL
do.call(lines, c(list(x = c(0,p(x)(supp[1])), y = rep(supp[1],2),
col = col.vert), dots.without.pch0))
+ plotInfo$qplot$lines <- c(list(x = c(0,p(x)(supp[1])), y = rep(supp[1],2),
+ col = col.vert), dots.without.pch0)
- if(do.points)
- {do.call(points, c(list(x = p(x)(supp[-length(supp)]),
+ if(do.points){
+ do.call(points, c(list(x = p(x)(supp[-length(supp)]),
y = supp[-1], pch = pch.u, cex = cex.points,
col = col.points), dots.for.points))
do.call(points, c(list(x = 0, y = supp[1], pch = pch.u,
- cex = cex.points, col = col.points), dots.for.points))}
+ cex = cex.points, col = col.points), dots.for.points))
+ plotInfo$qplot$points.u <- c(list(x = p(x)(supp[-length(supp)]),
+ y = supp[-1], pch = pch.u, cex = cex.points,
+ col = col.points), dots.for.points)
+ plotInfo$qplot$points.a <- c(list(x = 0, y = supp[1], pch = pch.u,
+ cex = cex.points, col = col.points), dots.for.points)
+ }
if(verticals && ngrid>1)
{dots.without.pch0 <- dots.without.pch
@@ -716,17 +836,25 @@
do.call(lines, c(list(x = rep(p(x)(supp[1]),2), y = c(supp[1],supp[2]),
col = col.vert), dots.without.pch0))
+ plotInfo$qplot$vlines <- c(list(x = rep(p(x)(supp[1]),2), y = c(supp[1],supp[2]),
+ col = col.vert), dots.without.pch0)
}
}
- if (mainL)
+ if (mainL){
mtext(text = main, side = 3, cex = cex.main, adj = .5,
outer = TRUE, padj = 1.4, col = col.main)
-
- if (subL)
+ plotInfo$mainL <- list(text = main, side = 3, cex = cex.main, adj = .5,
+ outer = TRUE, padj = 1.4, col = col.main)
+ }
+ if (subL){
mtext(text = sub, side = 1, cex = cex.sub, adj = .5,
outer = TRUE, line = -1.6, col = col.sub)
- return(invisible())
+ plotInfo$subL <- list(text = sub, side = 1, cex = cex.sub, adj = .5,
+ outer = TRUE, line = -1.6, col = col.sub)
+ }
+ class(plotInfo) <- c("plotInfo","DiagnInfo")
+ return(invisible(plotInfo))
}
)
@@ -734,9 +862,14 @@
setMethod("plot", signature(x = "DistrList", y = "missing"),
function(x, ...){
+ mc <- as.list(match.call(call = sys.call(sys.parent(1)),
+ expand.dots = TRUE)[-1])
+ plotInfoList <- vector("list",length(x))
+ plotInfoList$call <- mc
for(i in 1:length(x)){
devNew()
- plot(x[[i]],...)
+ plotInfoList[[i]] <- plot(x[[i]],...)
}
- return(invisible())
+ class(plotInfoList) <- c("plotInfo","DiagnInfo")
+ return(invisible(plotInfoList))
})
Modified: branches/distr-2.8/pkg/distr/R/plot-methods_LebDec.R
===================================================================
--- branches/distr-2.8/pkg/distr/R/plot-methods_LebDec.R 2018-07-11 17:44:44 UTC (rev 1197)
+++ branches/distr-2.8/pkg/distr/R/plot-methods_LebDec.R 2018-07-12 16:30:06 UTC (rev 1198)
@@ -15,9 +15,24 @@
withSubst = TRUE){
mc <- as.list(match.call(call = sys.call(sys.parent(1)), expand.dots = TRUE)[-1])
- do.call(getMethod("plot",
+ dots <- match.call(call = sys.call(sys.parent(1)),
+ expand.dots = FALSE)$"..."
+ ret <- do.call(getMethod("plot",
signature(x="UnivarLebDecDistribution",y="missing")), args = mc)
- return(invisible())
+ ret$dots <- dots
+ ret$call <- mc
+ ret$args <- list(x = x, width = width, height = height,
+ withSweave = withSweave, xlim = xlim, ylim = ylim, ngrid = ngrid,
+ verticals = verticals, do.points = do.points,
+ main = main, inner = inner, sub = sub, bmar = bmar, tmar = tmar,
+ cex.main = cex.main, cex.inner = cex.inner,
+ cex.sub = cex.sub, col.points = col.points,
+ col.hor = col.hor, col.vert = col.vert,
+ col.main = col.main, col.inner = col.inner,
+ col.sub = col.sub, cex.points = cex.points,
+ pch.u = pch.u, pch.a = pch.a, mfColRow = mfColRow, to.draw.arg = to.draw.arg,
+ withSubst = withSubst)
+ return(invisible(ret))
})
setMethod("plot", signature(x = "UnivarLebDecDistribution", y = "missing"),
@@ -34,8 +49,20 @@
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]
+ mc <- match.call(call = sys.call(sys.parent(1)), expand.dots = TRUE)
+ mc1 <- mc[-1]
xc <- mc$x
+ args0 <- list(x = x, width = width, height = height,
+ withSweave = withSweave, xlim = xlim, ylim = ylim, ngrid = ngrid,
+ verticals = verticals, do.points = do.points,
+ main = main, inner = inner, sub = sub, bmar = bmar, tmar = tmar,
+ cex.main = cex.main, cex.inner = cex.inner,
+ cex.sub = cex.sub, col.points = col.points,
+ col.hor = col.hor, col.vert = col.vert,
+ col.main = col.main, col.inner = col.inner,
+ col.sub = col.sub, cex.points = cex.points,
+ pch.u = pch.u, pch.a = pch.a, mfColRow = mfColRow, to.draw.arg = to.draw.arg,
+ withSubst = withSubst)
### manipulating the ... - argument
dots <- match.call(call = sys.call(sys.parent(1)),
@@ -76,7 +103,7 @@
x <- .ULC.cast(x)
if(is(x,"DiscreteDistribution")){
- mcl <- as.list(mc)
+ mcl <- as.list(mc1)
mcl$to.draw.arg <- (1:3)[( (6:8) %in%to.draw )]
mcl$ngrid <- NULL
whichPFL <- mcl$to.draw.arg
@@ -89,12 +116,15 @@
{inner <- .fillList(inner, 8)
mcl$inner <- inner[6:8]}
}
- do.call(plotD, mcl)
- return(invisible())
+ ret <- do.call(plotD, mcl)
+ ret$dots <- dots
+ ret$call <- mc
+ ret$args <- args0
+ return(invisible(ret))
}
if(is(x,"AbscontDistribution")){
- mcl <- as.list(mc)
+ mcl <- as.list(mc1)
mcl$col.hor <- NULL
if(is.null(mcl$xlab)) mcl$xlab <- xlab0.c
if(is.null(mcl$ylab)) mcl$ylab <- ylab0.c
@@ -107,14 +137,17 @@
{inner <- .fillList(inner, 8)
mcl$inner <- inner[6:8]}
}
- do.call(plotC, as.list(mcl))
- return(invisible())
+ ret <- do.call(plotC, as.list(mcl))
+ ret$dots <- dots
+ ret$call <- mc
+ ret$args <- args0
+ return(invisible(ret))
}
if(.isEqual(x at mixCoeff[1],0)){
x <- x at mixDistr[[2]]
- mcl <- as.list(mc)
+ mcl <- as.list(mc1)
if(is.null(mcl$xlab)) mcl$xlab <- xlab0.d
if(is.null(mcl$ylab)) mcl$ylab <- ylab0.d
mcl$x <- x
@@ -128,13 +161,16 @@
{inner <- .fillList(inner, 8)
mcl$inner <- inner[6:8]}
}
- do.call(plotD, as.list(mcl))
- return(invisible())
+ ret <- do.call(plotD, as.list(mcl))
+ ret$dots <- dots
+ ret$call <- mc
+ ret$args <- args0
+ return(invisible(ret))
}
if(.isEqual(x at mixCoeff[1],1)){
x <- x at mixDistr[[1]]
- mcl <- as.list(mc)
+ mcl <- as.list(mc1)
if(is.null(mcl$xlab)) mcl$xlab <- xlab0.c
if(is.null(mcl$ylab)) mcl$ylab <- ylab0.c
mcl$x <- x
@@ -148,10 +184,15 @@
{inner <- .fillList(inner, 8)
mcl$inner <- inner[6:8]}
}
- do.call(plotC, as.list(mcl))
- return(invisible())
+ ret <- do.call(plotC, as.list(mcl))
+ ret$dots <- dots
+ ret$call <- mc
+ ret$args <- args0
+ return(invisible(ret))
}
+ plotInfo <- list(call = mc, dots=dots, args=args0)
+
dots.for.points <- .makedotsPt(dots)
dots.lowlevel <- .makedotsLowLevel(dots)
@@ -421,15 +462,24 @@
pxv <- p(x)(xv)
}
+ plotInfo$to.draw <- to.draw
+ plotInfo$panelFirst <- pF
+ plotInfo$panelLast <- pL
+
o.warn <- getOption("warn"); options(warn = -1)
if(1 %in% to.draw){
on.exit(options(warn=o.warn))
dots.lowlevel$panel.first <- pF[[plotCount]]
dots.lowlevel$panel.last <- pL[[plotCount]]
dots.lowlevel$xlim <- xlim
+ plotInfo$pplot$plot <- c(list(x = grid, pxg, type = "l",
+ ylim = ylim2, ylab = ylab0[[1]][["p"]], xlab = xlab0[[1]][["p"]], log = logpd),
+ dots.lowlevel)
do.call(plot, c(list(x = grid, pxg, type = "l",
ylim = ylim2, ylab = ylab0[[1]][["p"]], xlab = xlab0[[1]][["p"]], log = logpd),
dots.lowlevel))
+ plotInfo$pplot$usr <- par("usr")
+
dots.lowlevel$panel.first <- dots.lowlevel$panel.last <- NULL
dots.lowlevel$xlim <- NULL
plotCount <- plotCount + 1
@@ -442,14 +492,22 @@
cex = cex.points, col = col.points), dots.for.points))
do.call(points, c(list(x = supp-del, y = pxg.d0, pch = pch.u,
cex = cex.points, col = col.points), dots.for.points))
+ plotInfo$pplot$points.u <- c(list(x = supp, y = pxg.d, pch = pch.a,
+ cex = cex.points, col = col.points), dots.for.points)
+ plotInfo$pplot$points.a <- c(list(x = supp-del, y = pxg.d0, pch = pch.u,
+ cex = cex.points, col = col.points), dots.for.points)
}
if(verticals){
do.call(lines, c(list(x = xv, y = pxv, col = col.vert),
dots.v))
+ plotInfo$pplot$vlines <- c(list(x = xv, y = pxv, col = col.vert),
+ dots.v)
}
title(main = inner.p, line = lineT, cex.main = cex.inner,
col.main = col.inner)
+ plotInfo$pplot$title <- list(main = inner.p, line = lineT,
+ cex.main = cex.inner, col.main = col.inner)
}
### quantiles
@@ -490,9 +548,13 @@
options(warn = -1)
dots.without.pch$panel.first <- pF[[plotCount]]
dots.without.pch$panel.last <- pL[[plotCount]]
+ plotInfo$qplot$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)
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))
+ plotInfo$qplot$usr <- par("usr")
plotCount <- plotCount + 1
dots.without.pch$panel.first <- dots.without.pch$panel.last <- NULL
options(warn = o.warn)
@@ -500,13 +562,17 @@
title(main = inner.q, line = lineT, cex.main = cex.inner,
col.main = col.inner)
-
+ plotInfo$qplot$title <- c(main = inner.q, line = lineT,
+ cex.main = cex.inner, col.main = col.inner)
+
options(warn = -1)
do.call(lines, c(list(x=po, y=xo), dots.for.lines))
# if (verticals && !is.null(gaps(x))){
# do.call(lines, c(list(rep(pu1,2), c(gaps(x)[,1],gaps(x)[,2]),
# col = col.vert), dots.without.pch))
# }
+ plotInfo$qplot$lines <- c(list(x=po, y=xo), dots.for.lines)
+
options(warn = o.warn)
@@ -516,33 +582,48 @@
o <- order(pu)
do.call(lines, c(list(pu[o], xu[o],
col = col.vert), dots.v))
+ plotInfo$qplot$vlines <- c(list(pu[o], xu[o],
+ col = col.vert), dots.v)
}
if(!is.null(gaps(x)) && do.points){
do.call(points, c(list(x = pu1, y = gaps(x)[,1], pch = pch.a,
cex = cex.points, col = col.points), dots.for.points) )
do.call(points, c(list(x = pu1, y = gaps(x)[,2], pch = pch.u,
cex = cex.points, col = col.points), dots.for.points) )
-
- }
+ plotInfo$qplot$points.u <- c(list(x = pu1, y = gaps(x)[,1], pch = pch.a,
+ cex = cex.points, col = col.points), dots.for.points)
+ plotInfo$qplot$points.a <- c(list(x = pu1, y = gaps(x)[,2], pch = pch.u,
+ cex = cex.points, col = col.points), dots.for.points)
+ }
if(do.points){
- if(is.finite(q.l(x)(0)))
+ if(is.finite(q.l(x)(0))){
do.call(points, c(list(x = 0, y = q.l(x)(0), pch = pch.u,
cex = cex.points, col = col.points), dots.for.points) )
- if(is.finite(q.l(x)(1)))
+ plotInfo$qplot$points0 <- c(list(x = 0, y = q.l(x)(0), pch = pch.u,
+ cex = cex.points, col = col.points), dots.for.points)
+ }
+ if(is.finite(q.l(x)(1))){
do.call(points, c(list(x = 1, y = q.l(x)(1), pch = pch.a,
cex = cex.points, col = col.points), dots.for.points) )
+ plotInfo$qplot$points0 <- c(list(x = 1, y = q.l(x)(1), pch = pch.a,
+ cex = cex.points, col = col.points), dots.for.points)
+ }
}
- if (mainL)
+ if (mainL){
mtext(text = main, side = 3, cex = cex.main, adj = .5,
outer = TRUE, padj = 1.4, col = col.main)
-
- if (subL)
+ plotInfo$mainL <- list(text = main, side = 3, cex = cex.main, adj = .5,
+ outer = TRUE, padj = 1.4, col = col.main)
+ }
+ if (subL){
mtext(text = sub, side = 1, cex = cex.sub, adj = .5,
outer = TRUE, line = -1.6, col = col.sub)
-
+ plotInfo$subL <- list(text = sub, side = 1, cex = cex.sub, adj = .5,
+ outer = TRUE, line = -1.6, col = col.sub)
}
- mc.ac <- mc
+ }
+ mc.ac <- mc1
if(!is.logical(inner))
mc.ac$inner <- lapply(inner[3:5], function(x)
if(is.character(x))
@@ -562,10 +643,10 @@
mc.ac$panel.first <- pF[whichPFL]
mc.ac$panel.last <- pL[whichPFL]
- do.call(plotC, c(list(acPart(x)),mc.ac), envir = parent.frame(2))
+ plotInfo$ac <- do.call(plotC, c(list(acPart(x)),mc.ac), envir = parent.frame(2))
plotCount <- plotCount + 3
- mc.di <- mc
+ mc.di <- mc1
if(!is.logical(inner))
mc.di$inner <- lapply(inner[6:8], function(x)
if(is.character(x))
@@ -585,10 +666,11 @@
whichPFL <- plotCount-1+mc.di$to.draw.arg
mc.di$panel.first <- pF[whichPFL]
mc.di$panel.last <- pL[whichPFL]
- do.call(plotD, c(list(discretePart(x)),mc.di), envir = parent.frame(2))
+ plotInfo$di <- do.call(plotD, c(list(discretePart(x)),mc.di), envir = parent.frame(2))
plotCount <- plotCount + 3
- return(invisible())
-
+ plotInfo$plotCount <- plotCount
+ class(plotInfo) <- c("plotInfo","DiagnInfo")
+ return(invisible(plotInfo))
}
)
@@ -596,8 +678,9 @@
function(x, ...) {
mc <- as.list(match.call(call = sys.call(sys.parent(1)),
expand.dots = TRUE)[-1])
- do.call(getMethod("plot",signature(x = "UnivarLebDecDistribution",
+ ret <- do.call(getMethod("plot",signature(x = "UnivarLebDecDistribution",
y = "missing")),args=mc)
- return(invisible())
+ ret$call <- mc
+ return(invisible(ret))
})
Modified: branches/distr-2.8/pkg/distr/R/qqplot.R
===================================================================
--- branches/distr-2.8/pkg/distr/R/qqplot.R 2018-07-11 17:44:44 UTC (rev 1197)
+++ branches/distr-2.8/pkg/distr/R/qqplot.R 2018-07-12 16:30:06 UTC (rev 1198)
@@ -94,6 +94,7 @@
if(mfColRow) opar1 <- par(mfrow = c(1,1), no.readonly = TRUE)
ret <- do.call(stats::qqplot, args=mcl)
+ qq.usr <- par("usr")
qqb <- NULL
if(withIdLine){
if(plot.it)abline(0,1,col=col.IdL,lty=lty.IdL,lwd=lwd.IdL)
@@ -152,7 +153,7 @@
}
}
}
- qqplotInfo <- c(ret, qqplotInfo, qqb)
+ qqplotInfo <- c(ret, usr=qq.usr, qqplotInfo, qqb)
class(qqplotInfo) <- c("qqplotInfo","DiagnInfo")
return(invisible(qqplotInfo))
})
Modified: branches/distr-2.8/pkg/distr/man/plot-methods.Rd
===================================================================
--- branches/distr-2.8/pkg/distr/man/plot-methods.Rd 2018-07-11 17:44:44 UTC (rev 1197)
+++ branches/distr-2.8/pkg/distr/man/plot-methods.Rd 2018-07-12 16:30:06 UTC (rev 1198)
@@ -216,6 +216,14 @@
run through in the same order as the panels).
}
+\value{An S3 object of class \code{c("plotInfo","DiagnInfo")}, i.e., a list
+ containing the information needed to produce the
+ respective plot, which at a later stage could be used by different
+ graphic engines (like, e.g. \code{ggplot}) to produce the plot
+ in a different framework. A more detailed description will follow in
+ a subsequent version.
+}
+
\examples{
plot(Binom(size = 4, prob = 0.3))
plot(Binom(size = 4, prob = 0.3), do.points = FALSE)
More information about the Distr-commits
mailing list