[Distr-commits] r1227 - branches/distr-2.8/pkg/distrMod/R pkg/distrMod/R
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Sun Jul 29 19:56:25 CEST 2018
Author: ruckdeschel
Date: 2018-07-29 19:56:25 +0200 (Sun, 29 Jul 2018)
New Revision: 1227
Modified:
branches/distr-2.8/pkg/distrMod/R/qqplot.R
branches/distr-2.8/pkg/distrMod/R/returnlevelplot.R
pkg/distrMod/R/qqplot.R
pkg/distrMod/R/returnlevelplot.R
Log:
[distrMod] bugfix in branch 2.8 and trunk:
- defaults for xlab ylab were not correctly set
Modified: branches/distr-2.8/pkg/distrMod/R/qqplot.R
===================================================================
--- branches/distr-2.8/pkg/distrMod/R/qqplot.R 2018-07-28 22:56:28 UTC (rev 1226)
+++ branches/distr-2.8/pkg/distrMod/R/qqplot.R 2018-07-29 17:56:25 UTC (rev 1227)
@@ -120,6 +120,15 @@
withSubst = TRUE
){ ## return value as in stats::qqplot
+ mc <- match.call(call = sys.call(sys.parent(1)))
+ xcc <- as.character(deparse(mc$x))
+ ycc <- as.character(deparse(mc$y))
+
+ if(missing(xlab)){ xlab <- mc$xlab <- xcc}
+ if(missing(ylab)){ ylab <- mc$ylab <- ycc}
+
+ dots <- match.call(call = sys.call(sys.parent(1)),
+ expand.dots = FALSE)$"..."
args0 <- list(x = x, y = y, n = n, withIdLine = withIdLine,
withConf = withConf, withConf.pw = withConf.pw,
withConf.sim = withConf.sim, plot.it = plot.it, datax = datax,
@@ -142,14 +151,8 @@
legend.cex = legend.cex, legend.pref = legend.pref,
legend.postf = legend.postf, legend.alpha = legend.alpha,
debug = debug, withSubst = withSubst)
- mc <- match.call(call = sys.call(sys.parent(1)))
- dots <- match.call(call = sys.call(sys.parent(1)),
- expand.dots = FALSE)$"..."
plotInfo <- list(call = mc, dots=dots, args=args0)
- xcc <- as.character(deparse(mc$x))
- ycc <- as.character(deparse(mc$y))
- if(missing(xlab)){ xlab <- mc$xlab <- xcc}
- if(missing(ylab)){ ylab <- mc$ylab <- ycc}
+
mcl <- as.list(mc)[-1]
force(x)
if(is.null(mcl$datax)) datax <- FALSE
@@ -414,8 +417,10 @@
ylab = deparse(substitute(y)), ...){
mc <- match.call(call = sys.call(sys.parent(1)))
- dots <- match.call(call = sys.call(sys.parent(1)),
- expand.dots = FALSE)$"..."
+ mc1 <- match.call(call = sys.call(sys.parent(1)), expand.dots=FALSE)
+ mcx <- as.character(deparse(mc$x))
+ mcy <- as.character(deparse(mc$y))
+ dots <- mc1$"..."
args0 <- list(x = x, y = y,
n = if(!missing(n)) n else length(x),
withIdLine = withIdLine, withConf = withConf,
@@ -424,8 +429,8 @@
plot.it = plot.it, xlab = xlab, ylab = ylab)
plotInfo <- list(call=mc, dots=dots, args=args0)
- if(missing(xlab)) mc$xlab <- as.character(deparse(mc$x))
- if(missing(ylab)) mc$ylab <- as.character(deparse(mc$y))
+ if(missing(xlab)) mc$xlab <- mcx
+ if(missing(ylab)) mc$ylab <- mcy
mcl <- as.list(mc)[-1]
mcl$y <- yD <- y at distribution
@@ -447,18 +452,20 @@
plot.it = TRUE, xlab = deparse(substitute(x)),
ylab = deparse(substitute(y)), ...){
+ mc <- match.call(call = sys.call(sys.parent(1)))
+ mc1 <- match.call(call = sys.call(sys.parent(1)), expand.dots=FALSE)
+ mcx <- as.character(deparse(mc$x))
+ mcy <- as.character(deparse(mc$y))
+
args0 <- list(x=x,y=y,n=n,withIdLine=withIdLine, withConf=withConf,
withConf.pw = if(!missing(withConf.pw)) withConf.pw else if(!missing(withConf)) withConf else NULL,
withConf.sim = if(!missing(withConf.sim)) withConf.sim else if(!missing(withConf)) withConf else NULL,
plot.it = plot.it, xlab = xlab, ylab = ylab)
- mc <- match.call(call = sys.call(sys.parent(1)))
- mc1 <- match.call(call = sys.call(sys.parent(1)), expand.dots=FALSE)
dots <- mc1$"..."
plotInfo <- list(call=mc, dots=dots, args=args0)
- if(missing(xlab)) mc$xlab <- as.character(deparse(mc$x))
- if(missing(ylab)) mc$ylab <- as.character(deparse(mc$y))
+ if(missing(xlab)) mc$xlab <- mcx
mcl <- as.list(mc)[-1]
param <- ParamFamParameter(main=untransformed.estimate(y), nuisance=nuisance(y),
@@ -474,6 +481,7 @@
PFam0 <- modifyModel(PFam, param)
mcl$y <- PFam0
+ if(missing(ylab)) mcl$ylab <- paste(name(PFam0),gettext("fitted by"), mcy)
retv <- do.call(getMethod("qqplot", signature(x="ANY", y="ProbFamily")),
args=mcl)
retv$call <- retv$dots <- retv$args <- NULL
Modified: branches/distr-2.8/pkg/distrMod/R/returnlevelplot.R
===================================================================
--- branches/distr-2.8/pkg/distrMod/R/returnlevelplot.R 2018-07-28 22:56:28 UTC (rev 1226)
+++ branches/distr-2.8/pkg/distrMod/R/returnlevelplot.R 2018-07-29 17:56:25 UTC (rev 1227)
@@ -79,6 +79,9 @@
debug = FALSE, ## shall additional debug output be printed out?
withSubst = TRUE
){ ## return value as in stats::qqplot
+ 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, y = y, n = n, withIdLine = withIdLine,
withConf = withConf, withConf.pw = withConf.pw,
withConf.sim = withConf.sim, plot.it = plot.it, datax = datax,
@@ -101,9 +104,6 @@
legend.cex = legend.cex, legend.pref = legend.pref,
legend.postf = legend.postf, legend.alpha = legend.alpha,
debug = debug, withSubst = withSubst)
- mc <- match.call(call = sys.call(sys.parent(1)))
- dots <- match.call(call = sys.call(sys.parent(1)),
- expand.dots = FALSE)$"..."
plotInfo <- list(call = mc, dots=dots, args=args0)
MaxOrPOT <- match.arg(MaxOrPOT)
@@ -118,9 +118,8 @@
xcc))
}else function(inx)inx
- if(missing(xlab)) mc$xlab <- paste(gettext("Return level of"),
- as.character(deparse(mc$x)))
- if(missing(ylab)) mc$ylab <- gettext("Return period (years)")
+ if(missing(xlab)){mc$xlab <- paste(gettext("Return level of"), xcc)}
+ if(missing(ylab)){mc$ylab <- gettext("Return period (years)")}
if(missing(main)) mc$main <- gettext("Return level plot")
mcl <- as.list(mc)[-1]
mcl$datax <- NULL
@@ -302,8 +301,8 @@
mcl$cex <- cex.pts
mcl$col <- col.pts
- mcl$xlab <- .mpresubs(mcl$xlab)
- mcl$ylab <- .mpresubs(mcl$ylab)
+ mc$xlab <- .mpresubs(mcl$xlab)
+ mc$ylab <- .mpresubs(mcl$ylab)
if (!withSweave){
devNew(width = width, height = height)
@@ -327,13 +326,13 @@
mcl$log <- NULL
}
if(datax){
- mcl$xlab <- xlab
- mcl$ylab <- ylab
+ mcl$xlab <- mc$xlab
+ mcl$ylab <- mc$ylab
plotInfo$plotArgs <- c(list(x=xallc1, y=yallc1, log=logs, type="n"),mcl)
plotInfo$pointArgs <- c(list(x=xso, y=ycso), mcl)
}else{
- mcl$ylab <- xlab
- mcl$xlab <- ylab
+ mcl$ylab <- mc$xlab
+ mcl$xlab <- mc$ylab
plotInfo$plotArgs <- c(list(x=yallc1, y=xallc1, log=logs,type="n"),mcl)
plotInfo$pointArgs <- c(list(x=ycso, y=xso), mcl)
}
@@ -420,8 +419,10 @@
ylab = deparse(substitute(y)), ...){
mc <- match.call(call = sys.call(sys.parent(1)))
- dots <- match.call(call = sys.call(sys.parent(1)),
- expand.dots = FALSE)$"..."
+ mc1 <- match.call(call = sys.call(sys.parent(1)), expand.dots=FALSE)
+ mcx <- as.character(deparse(mc$x))
+ mcy <- as.character(deparse(mc$y))
+ dots <- mc1$"..."
args0 <- list(x = x, y = y,
n = if(!missing(n)) n else length(x),
withIdLine = withIdLine, withConf = withConf,
@@ -431,8 +432,8 @@
plotInfo <- list(call=mc, dots=dots, args=args0)
- if(missing(xlab)) mc$xlab <- paste(gettext("Return Level of"), as.character(deparse(mc$x)))
- if(missing(ylab)) mc$ylab <- paste(gettext("Return Period at"), as.character(deparse(mc$y)))
+ if(missing(xlab)) mc$xlab <- paste(gettext("Return Level of"), mcx)
+ if(missing(ylab)) mc$ylab <- paste(gettext("Return Period at"), mcy)
mcl <- as.list(mc)[-1]
mcl$y <- yD <- y at distribution
@@ -455,8 +456,10 @@
ylab = deparse(substitute(y)), ...){
mc <- match.call(call = sys.call(sys.parent(1)))
- dots <- match.call(call = sys.call(sys.parent(1)),
- expand.dots = FALSE)$"..."
+ mc1 <- match.call(call = sys.call(sys.parent(1)), expand.dots=FALSE)
+ mcx <- as.character(deparse(mc$x))
+ mcy <- as.character(deparse(mc$y))
+ dots <- mc1$"..."
args0 <- list(x = x, y = y,
n = if(!missing(n)) n else length(x),
withIdLine = withIdLine, withConf = withConf,
@@ -466,7 +469,7 @@
plotInfo <- list(call=mc, dots=dots, args=args0)
- if(missing(xlab)) mc$xlab <- paste(gettext("Return Level of"), as.character(deparse(mc$x)))
+ if(missing(xlab)) mc$xlab <- paste(gettext("Return Level of"), mcx)
mcl <- as.list(mc)[-1]
param <- ParamFamParameter(main=untransformed.estimate(y), nuisance=nuisance(y),
@@ -482,7 +485,7 @@
PFam0 <- modifyModel(PFam, param)
mcl$y <- PFam0
- if(missing(ylab)) mcl$ylab <- paste(gettext("Return Period at fitted"), name(PFam0))
+ if(missing(ylab)) mcl$ylab <- paste(gettext("Return Period at fitted"), name(PFam0), "\n -- fit by ", mcy)
retv <- do.call(getMethod("returnlevelplot", signature(x="ANY", y="ProbFamily")),
args=mcl)
Modified: pkg/distrMod/R/qqplot.R
===================================================================
--- pkg/distrMod/R/qqplot.R 2018-07-28 22:56:28 UTC (rev 1226)
+++ pkg/distrMod/R/qqplot.R 2018-07-29 17:56:25 UTC (rev 1227)
@@ -388,8 +388,10 @@
ylab = deparse(substitute(y)), ...){
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))
+ mcx <- as.character(deparse(mc$x))
+ mcy <- as.character(deparse(mc$y))
+ if(missing(xlab)) mc$xlab <- mcx
+ if(missing(ylab)) mc$ylab <- mcy
mcl <- as.list(mc)[-1]
mcl$y <- yD <- y at distribution
@@ -410,8 +412,10 @@
ylab = deparse(substitute(y)), ...){
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))
+ mc1 <- match.call(call = sys.call(sys.parent(1)), expand.dots=FALSE)
+ mcx <- as.character(deparse(mc$x))
+ mcy <- as.character(deparse(mc$y))
+ if(missing(xlab)) mc$xlab <- mcx
mcl <- as.list(mc)[-1]
param <- ParamFamParameter(main=untransformed.estimate(y), nuisance=nuisance(y),
@@ -427,6 +431,7 @@
PFam0 <- modifyModel(PFam, param)
mcl$y <- PFam0
+ if(missing(ylab)) mcl$ylab <- paste(name(PFam0),gettext("fitted by"), mcy)
retv <- do.call(getMethod("qqplot", signature(x="ANY", y="ProbFamily")),
args=mcl)
retv$call <- mc
Modified: pkg/distrMod/R/returnlevelplot.R
===================================================================
--- pkg/distrMod/R/returnlevelplot.R 2018-07-28 22:56:28 UTC (rev 1226)
+++ pkg/distrMod/R/returnlevelplot.R 2018-07-29 17:56:25 UTC (rev 1227)
@@ -92,9 +92,8 @@
xcc))
}else function(inx)inx
- if(missing(xlab)) mc$xlab <- paste(gettext("Return level of"),
- as.character(deparse(mc$x)))
- if(missing(ylab)) mc$ylab <- gettext("Return period (years)")
+ if(missing(xlab)){mc$xlab <- paste(gettext("Return level of"), xcc)}
+ if(missing(ylab)){mc$ylab <- gettext("Return period (years)")}
if(missing(main)) mc$main <- gettext("Return level plot")
mcl <- as.list(mc)[-1]
mcl$datax <- NULL
@@ -276,8 +275,8 @@
mcl$cex <- cex.pts
mcl$col <- col.pts
- mcl$xlab <- .mpresubs(mcl$xlab)
- mcl$ylab <- .mpresubs(mcl$ylab)
+ mc$xlab <- .mpresubs(mcl$xlab)
+ mc$ylab <- .mpresubs(mcl$ylab)
if (!withSweave){
devNew(width = width, height = height)
@@ -301,13 +300,13 @@
mcl$log <- NULL
}
if(datax){
- mcl$xlab <- xlab
- mcl$ylab <- ylab
+ mcl$xlab <- mc$xlab
+ mcl$ylab <- mc$ylab
do.call(plot, c(list(x=xallc1, y=yallc1, log=logs,type="n"),mcl))
do.call(points, c(list(x=xso, y=ycso), mcl))
}else{
- mcl$ylab <- xlab
- mcl$xlab <- ylab
+ mcl$ylab <- mc$xlab
+ mcl$xlab <- mc$ylab
do.call(plot, c(list(x=yallc1, y=xallc1, log=logs,type="n"),mcl))
do.call(points, c(list(x=ycso, y=xso), mcl))
}
@@ -384,8 +383,10 @@
ylab = deparse(substitute(y)), ...){
mc <- match.call(call = sys.call(sys.parent(1)))
- if(missing(xlab)) mc$xlab <- paste(gettext("Return Level of"), as.character(deparse(mc$x)))
- if(missing(ylab)) mc$ylab <- paste(gettext("Return Period at"), as.character(deparse(mc$y)))
+ mcx <- as.character(deparse(mc$x))
+ mcy <- as.character(deparse(mc$y))
+ if(missing(xlab)) mc$xlab <- paste(gettext("Return Level of"), mcx)
+ if(missing(ylab)) mc$ylab <- paste(gettext("Return Period at"), mcy)
mcl <- as.list(mc)[-1]
mcl$y <- yD <- y at distribution
@@ -404,6 +405,9 @@
ylab = deparse(substitute(y)), ...){
mc <- match.call(call = sys.call(sys.parent(1)))
+ mc1 <- match.call(call = sys.call(sys.parent(1)), expand.dots=FALSE)
+ mcx <- as.character(deparse(mc$x))
+ mcy <- as.character(deparse(mc$y))
if(missing(xlab)) mc$xlab <- paste(gettext("Return Level of"), as.character(deparse(mc$x)))
mcl <- as.list(mc)[-1]
@@ -420,7 +424,7 @@
PFam0 <- modifyModel(PFam, param)
mcl$y <- PFam0
- if(missing(ylab)) mcl$ylab <- paste(gettext("Return Period at fitted"), name(PFam0))
+ if(missing(ylab)) mcl$ylab <- paste(gettext("Return Period at fitted"), name(PFam0), "\n -- fit by ", mcy)
return(invisible(do.call(getMethod("returnlevelplot", signature(x="ANY", y="ProbFamily")),
args=mcl)))
More information about the Distr-commits
mailing list