[Distr-commits] r1202 - in branches/distr-2.8/pkg/distrMod: R inst man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Thu Jul 12 19:21:57 CEST 2018
Author: ruckdeschel
Date: 2018-07-12 19:21:57 +0200 (Thu, 12 Jul 2018)
New Revision: 1202
Modified:
branches/distr-2.8/pkg/distrMod/R/AllPlot.R
branches/distr-2.8/pkg/distrMod/R/qqplot.R
branches/distr-2.8/pkg/distrMod/inst/NEWS
branches/distr-2.8/pkg/distrMod/man/L2ParamFamily-class.Rd
branches/distr-2.8/pkg/distrMod/man/ParamFamily-class.Rd
Log:
[distrMod] 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/distrMod/R/AllPlot.R
===================================================================
--- branches/distr-2.8/pkg/distrMod/R/AllPlot.R 2018-07-12 17:05:18 UTC (rev 1201)
+++ branches/distr-2.8/pkg/distrMod/R/AllPlot.R 2018-07-12 17:21:57 UTC (rev 1202)
@@ -3,9 +3,16 @@
function(x, ...){
e1 <- x at distribution
if(!is(e1, "UnivariateDistribution")) stop("not yet implemented")
+ mc <- match.call(call = sys.call(sys.parent(1)))
+ dots <- match.call(call = sys.call(sys.parent(1)),
+ expand.dots = FALSE)$"..."
+ args0 <- list(x=x)
+ plotInfo <- list(call = mc, dots=dots, args=args0)
+ plotInfo$distribution <- plot(e1,...)
+ class(plotInfo) <- c("plotInfo","DiagnInfo")
+ return(invisible(plotInfo))
+ })
- plot(e1)
- })
setMethod("plot", signature(x = "L2ParamFamily", y = "missing"),
function(x, withSweave = getdistrOption("withSweave"),
main = FALSE, inner = TRUE, sub = FALSE,
@@ -13,7 +20,16 @@
bmar = par("mar")[1], tmar = par("mar")[3], ...,
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)))
+ dots <- match.call(call = sys.call(sys.parent(1)),
+ expand.dots = FALSE)$"..."
+ args0 <- list(x=x, withSweave = withSweave,
+ main = main, inner = inner, sub = sub,
+ col.inner = col.inner, cex.inner = cex.inner,
+ bmar = bmar, tmar = tmar, mfColRow = mfColRow,
+ to.draw.arg = to.draw.arg, withSubst= withSubst)
+ plotInfo <- list(call = mc, dots=dots, args=args0)
+ xc <- mc$x
xcc <- as.character(deparse(xc))
.mpresubs <- if(withSubst){
function(inx)
@@ -23,9 +39,7 @@
xcc))
}else function(inx)inx
- dots <- match.call(call = sys.call(sys.parent(1)),
- expand.dots = FALSE)$"..."
-
+
dots$to.draw.arg <- NULL
trafO <- trafo(x at param)
# dims <- nrow(trafO)
@@ -54,6 +68,12 @@
pl <- .panel.mingle(dots,"panel.last")
}
pL <- .fillList(pL, length(to.draw))
+
+ plotInfo$to.draw <- to.draw
+ plotInfo$panelFirst <- pF
+ plotInfo$panelLast <- pL
+
+
plotCount <- 1
l2dpl <- to.draw[to.draw > 3]
@@ -224,7 +244,8 @@
lis0$to.draw.arg <- todrw
lis0[["panel.first"]] <- pF[plotCount+(0:2)]
lis0[["panel.last"]] <- pL[plotCount+(0:2)]
- do.call(plot, args = lis0)
+ plotInfo$distr <- do.call(plot, args = lis0)
+ plotInfo$distr$List <- lis0
plotCount <- plotCount + 1
}
o.warn <- options("warn")
@@ -245,40 +266,61 @@
parArgs <- c(parArgs,list(mar = c(bmar,omar[2],tmar,omar[4]), no.readonly = TRUE))
dots$ylim <- NULL
+ plotInfo$parArgs <- parArgs
do.call(par,args=parArgs)
+
+ plotInfo$L2derivPlotUsr <- plotInfo$L2derivPlotArgs <- vector("list",dims0)
+ plotInfo$L2derivPlotLines <- plotInfo$L2derivPlotTitle <- vector("list",dims0)
for(i in 1:dims0){
indi <- l2dpl[i]-3
if(!is.null(ylim)) dots$ylim <- ylim[,d.0+d.1+i]
dots$panel.first <- pF[[plotCount]]
dots$panel.last <- pL[[plotCount]]
- do.call(plot, args=c(list(x=x.vec, y=sapply(x.vec, L2deriv at Map[[indi]]),
- type = plty, lty = lty,
- xlab = "x",
- ylab = expression(paste(L[2], " derivative"))),
- dots))
+ plotInfo$L2derivPlotArgs[[i]] <- c(list(x=x.vec,
+ y=sapply(x.vec, L2deriv at Map[[indi]]),
+ type = plty, lty = lty, xlab = "x",
+ ylab = expression(paste(L[2], " derivative"))),
+ dots)
+ do.call(plot, args=c(list(x=x.vec,
+ y=sapply(x.vec, L2deriv at Map[[indi]]),
+ type = plty, lty = lty, xlab = "x",
+ ylab = expression(paste(L[2], " derivative"))),
+ dots))
+ plotInfo$L2derivPlotUsr[[i]] <- par("usr")
plotCount <- plotCount + 1
if(is(e1, "DiscreteDistribution")){
x.vec1 <- seq(from = min(x.vec), to = max(x.vec), length = 1000)
do.call(lines, args=c(list(x.vec1, sapply(x.vec1, L2deriv at Map[[indi]]),
lty = "dotted"),dots))
+ plotInfo$L2derivPlotLines[[i]] <- c(list(x.vec1, sapply(x.vec1,
+ L2deriv at Map[[indi]]), lty = "dotted"),dots)
}
- if(innerLog)
+ if(innerLog){
do.call(title, args = c(list(main = innerT[i]), dotsT,
line = lineT, cex.main = cex.inner,
col.main = col.inner))
+ plotInfo$L2derivPlotTitle[[i]] <- c(list(main = innerT[i]), dotsT,
+ line = lineT, cex.main = cex.inner,
+ col.main = col.inner)
+ }
}
if(!hasArg(cex.main)) cex.main <- par("cex.main") else cex.main <- dots$"cex.main"
if(!hasArg(col.main)) col.main <- par("col.main") else col.main <- dots$"col.main"
- if (mainL)
+ if (mainL){
mtext(text = main, side = 3, cex = cex.main, adj = .5,
outer = TRUE, padj = 1.4, col = col.main)
-
+ plotInfo$mainL <- list(text = main, side = 3, cex = cex.main, adj = .5,
+ outer = TRUE, padj = 1.4, col = col.main)
+ }
if(!hasArg(cex.sub)) cex.sub <- par("cex.sub") else cex.sub <- dots$"cex.sub"
if(!hasArg(col.sub)) col.sub <- par("col.sub") else col.sub <- dots$"col.sub"
- if (subL)
+ if (subL){
mtext(text = sub, side = 1, cex = cex.sub, adj = .5,
outer = TRUE, line = -1.6, col = col.sub)
-
- 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))
})
Modified: branches/distr-2.8/pkg/distrMod/R/qqplot.R
===================================================================
--- branches/distr-2.8/pkg/distrMod/R/qqplot.R 2018-07-12 17:05:18 UTC (rev 1201)
+++ branches/distr-2.8/pkg/distrMod/R/qqplot.R 2018-07-12 17:21:57 UTC (rev 1202)
@@ -192,6 +192,7 @@
if(mfColRow) opar1 <- par(mfrow = c(1,1), no.readonly = TRUE)
ret <- do.call(stats::qqplot, args=mcl)
+ qq.usr <- par("usr")
lbprep <- NULL
if(withLab&& plot.it){
lbprep <- .labelprep(xj,yc,lab.pts,
@@ -270,7 +271,7 @@
}
}
}
- qqplotInfo <- c(call=mc, ret, qqplotInfo, qqb)
+ qqplotInfo <- c(call=mc, ret, usr=qq.usr, qqplotInfo, qqb)
class(qqplotInfo) <- c("qqplotInfo","DiagnInfo")
return(invisible(qqplotInfo))
})
Modified: branches/distr-2.8/pkg/distrMod/inst/NEWS
===================================================================
--- branches/distr-2.8/pkg/distrMod/inst/NEWS 2018-07-12 17:05:18 UTC (rev 1201)
+++ branches/distr-2.8/pkg/distrMod/inst/NEWS 2018-07-12 17:21:57 UTC (rev 1202)
@@ -8,6 +8,16 @@
information)
##############
+v 2.8
+##############
+
+user-visible CHANGES:
+
+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.
+
+##############
v 2.7
##############
Modified: branches/distr-2.8/pkg/distrMod/man/L2ParamFamily-class.Rd
===================================================================
--- branches/distr-2.8/pkg/distrMod/man/L2ParamFamily-class.Rd 2018-07-12 17:05:18 UTC (rev 1201)
+++ branches/distr-2.8/pkg/distrMod/man/L2ParamFamily-class.Rd 2018-07-12 17:21:57 UTC (rev 1202)
@@ -214,14 +214,21 @@
\item{\code{"\%D"}}{time/date-string when the plot was generated}
}
-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).
- }
+ 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).
+ The return value of the plot methods is 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.
+}
\item{modifyModel}{\code{signature(model = "L2ParamFamily", param = "ParamFamParameter")}:
moves the L2-parametric Family \code{model} to parameter \code{param} }
Modified: branches/distr-2.8/pkg/distrMod/man/ParamFamily-class.Rd
===================================================================
--- branches/distr-2.8/pkg/distrMod/man/ParamFamily-class.Rd 2018-07-12 17:05:18 UTC (rev 1201)
+++ branches/distr-2.8/pkg/distrMod/man/ParamFamily-class.Rd 2018-07-12 17:21:57 UTC (rev 1202)
@@ -105,8 +105,18 @@
accessor function for slot \code{fam.call}. }
\item{plot}{\code{signature(x = "ParamFamily")}:
- plot of slot \code{distribution}. }
+ plot of slot \code{distribution}.
+ The return value of the plot method is 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.
+
+ }
+
\item{show}{\code{signature(object = "ParamFamily")}}
}
More information about the Distr-commits
mailing list