[Distr-commits] r1224 - branches/distr-2.8/pkg/distrMod/R branches/distr-2.8/pkg/distrMod/inst pkg/distrMod/R pkg/distrMod/inst
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Thu Jul 26 08:24:57 CEST 2018
Author: ruckdeschel
Date: 2018-07-26 08:24:55 +0200 (Thu, 26 Jul 2018)
New Revision: 1224
Modified:
branches/distr-2.8/pkg/distrMod/R/qqplot.R
branches/distr-2.8/pkg/distrMod/R/returnlevelplot.R
branches/distr-2.8/pkg/distrMod/inst/NEWS
pkg/distrMod/R/qqplot.R
pkg/distrMod/R/returnlevelplot.R
pkg/distrMod/inst/NEWS
Log:
[distrMod] yet some little buglets --
+ Estimate method for returnlevelplot was passing the wrong xlab
+ the selection mechanism had to be revised (lacked a passage through ranks)
+ returnlevelplot now accepts a log argument for the y axis (helpful for Pareto distributions, see script...)
Modified: branches/distr-2.8/pkg/distrMod/R/qqplot.R
===================================================================
--- branches/distr-2.8/pkg/distrMod/R/qqplot.R 2018-07-26 04:51:52 UTC (rev 1223)
+++ branches/distr-2.8/pkg/distrMod/R/qqplot.R 2018-07-26 06:24:55 UTC (rev 1224)
@@ -207,8 +207,8 @@
shown <- c(lbprep$ord,lbprep$ns)
- xs <- xj[shown]
- ycs <- yc.o[shown]
+ xs <- x[shown]
+ ycs <- (yc.o[rank1x])[shown]
ordx <- order(xs)
xso <- xs[ordx]
Modified: branches/distr-2.8/pkg/distrMod/R/returnlevelplot.R
===================================================================
--- branches/distr-2.8/pkg/distrMod/R/returnlevelplot.R 2018-07-26 04:51:52 UTC (rev 1223)
+++ branches/distr-2.8/pkg/distrMod/R/returnlevelplot.R 2018-07-26 06:24:55 UTC (rev 1224)
@@ -211,8 +211,8 @@
shown <- c(lbprep$ord,lbprep$ns)
- xs <- xj[shown]
- ycs <- ycl[shown]
+ xs <- x[shown]
+ ycs <- (ycl[rank1x])[shown]
ordx <- order(xs)
xso <- xs[ordx]
@@ -302,6 +302,7 @@
mcl <- .deleteItemsMCL(mcl)
mcl$cex <- cex.pch
mcl$col <- col.pch
+ mcl$MaxOrPOT <- NULL
if (!withSweave){
devNew(width = width, height = height)
@@ -317,18 +318,22 @@
xallc1 <- sort(c(xj,xyallc))
yallc1 <- sort(c(ycl,pxyallc))
mcl$x <- mcl$y <- NULL
+ logs <- if(datax) "y" else "x"
+ if(!is.null(mcl$log)){
+ if(grepl("y", eval(mcl$log))) logs <- "xy"
+ if(grepl("x",eval(mcl$log)))
+ warning("The x axis is logarithmic anyway.")
+ mcl$log <- NULL
+ }
if(datax){
mcl$xlab <- xlab
mcl$ylab <- ylab
- plotInfo$plotArgs <- c(list(x=xallc1, y=yallc1, log="y",type="n"),mcl)
-# plotInfo$pointArgs <- c(list(x=xj, y=ycl), mcl)
+ plotInfo$plotArgs <- c(list(x=xallc1, y=yallc1, log=logs, type="n"),mcl)
plotInfo$pointArgs <- c(list(x=xso, y=ycso), mcl)
- # ret <- do.call(stats::qqplot, args=mcl0, log="y", ylim = c(0.1,1000))
}else{
mcl$ylab <- xlab
mcl$xlab <- ylab
- plotInfo$plotArgs <- c(list(x=yallc1, y=xallc1, log="x",type="n"),mcl)
-# plotInfo$pointArgs <- c(list(x=ycl, y=xj), mcl)
+ plotInfo$plotArgs <- c(list(x=yallc1, y=xallc1, log=logs,type="n"),mcl)
plotInfo$pointArgs <- c(list(x=ycso, y=xso), mcl)
}
do.call(plot, plotInfo$plotArgs)
@@ -428,6 +433,7 @@
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)))
mcl <- as.list(mc)[-1]
+
mcl$y <- yD <- y at distribution
if(!is(yD,"UnivariateDistribution"))
stop("Not yet implemented.")
@@ -447,6 +453,7 @@
plot.it = TRUE, xlab = deparse(substitute(x)),
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)$"..."
@@ -457,6 +464,8 @@
withConf.sim = if(!missing(withConf.sim)) withConf.sim else if(!missing(withConf)) withConf else NULL,
plot.it = plot.it, xlab = xlab, ylab = ylab)
+ plotInfo <- list(call=mc, dots=dots, args=args0)
+
if(missing(xlab)) mc$xlab <- paste(gettext("Return Level of"), as.character(deparse(mc$x)))
mcl <- as.list(mc)[-1]
@@ -473,7 +482,7 @@
PFam0 <- modifyModel(PFam, param)
mcl$y <- PFam0
- if(missing(ylab)) mc$ylab <- paste(gettext("Return Period at fitted"), name(PFam0))
+ if(missing(ylab)) mcl$ylab <- paste(gettext("Return Period at fitted"), name(PFam0))
retv <- do.call(getMethod("returnlevelplot", signature(x="ANY", y="ProbFamily")),
args=mcl)
Modified: branches/distr-2.8/pkg/distrMod/inst/NEWS
===================================================================
--- branches/distr-2.8/pkg/distrMod/inst/NEWS 2018-07-26 04:51:52 UTC (rev 1223)
+++ branches/distr-2.8/pkg/distrMod/inst/NEWS 2018-07-26 06:24:55 UTC (rev 1224)
@@ -38,12 +38,17 @@
- the non-shown observations (the remaining ones not contained in the former 2 grps)
-> point attributes may either refer to prior selection or to post-selection in
which case we have .npts variants
++ returnlevelplot now accepts a log argument for the y axis (helpful for Pareto distributions, see script...)
under the hood:
+ wherever possible also use q.l internally instead of q to
provide functionality in IRKernel
+ fixed omegahat.net issue (raised by K.Hornik,(24.10.2016, 18:08)
+bug fixes:
++ Estimate method for returnlevelplot was passing the wrong xlab
++ the selection mechanism had to be revised (lacked a passage through ranks)
+
##############
v 2.6
##############
Modified: pkg/distrMod/R/qqplot.R
===================================================================
--- pkg/distrMod/R/qqplot.R 2018-07-26 04:51:52 UTC (rev 1223)
+++ pkg/distrMod/R/qqplot.R 2018-07-26 06:24:55 UTC (rev 1224)
@@ -183,8 +183,8 @@
shown <- c(lbprep$ord,lbprep$ns)
- xs <- xj[shown]
- ycs <- yc.o[shown]
+ xs <- x[shown]
+ ycs <- (yc.o[rank1x])[shown]
ordx <- order(xs)
xso <- xs[ordx]
Modified: pkg/distrMod/R/returnlevelplot.R
===================================================================
--- pkg/distrMod/R/returnlevelplot.R 2018-07-26 04:51:52 UTC (rev 1223)
+++ pkg/distrMod/R/returnlevelplot.R 2018-07-26 06:24:55 UTC (rev 1224)
@@ -184,8 +184,8 @@
shown <- c(lbprep$ord,lbprep$ns)
- xs <- xj[shown]
- ycs <- ycl[shown]
+ xs <- x[shown]
+ ycs <- (ycl[rank1x])[shown]
ordx <- order(xs)
xso <- xs[ordx]
@@ -293,18 +293,23 @@
xallc1 <- sort(c(xj,xyallc))
yallc1 <- sort(c(ycl,pxyallc))
mcl$x <- mcl$y <- NULL
+ logs <- if(datax) "y" else "x"
+ if(!is.null(mcl$log)){
+ if(grepl("y", eval(mcl$log))) logs <- "xy"
+ if(grepl("x",eval(mcl$log)))
+ warning("The x axis is logarithmic anyway.")
+ mcl$log <- NULL
+ }
if(datax){
mcl$xlab <- xlab
mcl$ylab <- ylab
- do.call(plot, c(list(x=xallc1, y=yallc1, log="y",type="n"),mcl))
+ do.call(plot, c(list(x=xallc1, y=yallc1, log=logs,type="n"),mcl))
do.call(points, c(list(x=xso, y=ycso), mcl))
-# c(list(x=xj, y=ycl), mcl)
}else{
mcl$ylab <- xlab
mcl$xlab <- ylab
- do.call(plot, c(list(x=yallc1, y=xallc1, log="x",type="n"),mcl))
+ do.call(plot, c(list(x=yallc1, y=xallc1, log=logs,type="n"),mcl))
do.call(points, c(list(x=ycso, y=xso), mcl))
-# c(list(x=ycl, y=xj), mcl)
}
}
@@ -415,7 +420,7 @@
PFam0 <- modifyModel(PFam, param)
mcl$y <- PFam0
- if(missing(ylab)) mc$ylab <- paste(gettext("Return Period at fitted"), name(PFam0))
+ if(missing(ylab)) mcl$ylab <- paste(gettext("Return Period at fitted"), name(PFam0))
return(invisible(do.call(getMethod("returnlevelplot", signature(x="ANY", y="ProbFamily")),
args=mcl)))
Modified: pkg/distrMod/inst/NEWS
===================================================================
--- pkg/distrMod/inst/NEWS 2018-07-26 04:51:52 UTC (rev 1223)
+++ pkg/distrMod/inst/NEWS 2018-07-26 06:24:55 UTC (rev 1224)
@@ -27,13 +27,17 @@
- the non-shown observations (the remaining ones not contained in the former 2 grps)
-> point attributes may either refer to prior selection or to post-selection in
which case we have .npts variants
++ returnlevelplot now accepts a log argument for the y axis (helpful for Pareto distributions, see script...)
-
under the hood:
+ wherever possible also use q.l internally instead of q to
provide functionality in IRKernel
+ fixed omegahat.net issue (raised by K.Hornik,(24.10.2016, 18:08)
+bug fixes:
++ Estimate method for returnlevelplot was passing the wrong xlab
++ the selection mechanism had to be revised (lacked a passage through ranks)
+
##############
v 2.6
##############
More information about the Distr-commits
mailing list