[Distr-commits] r958 - in branches/distr-2.6/pkg/distrMod: R inst man

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Sun Aug 10 19:26:22 CEST 2014


Author: ruckdeschel
Date: 2014-08-10 19:26:21 +0200 (Sun, 10 Aug 2014)
New Revision: 958

Modified:
   branches/distr-2.6/pkg/distrMod/R/qqplot.R
   branches/distr-2.6/pkg/distrMod/R/returnlevelplot.R
   branches/distr-2.6/pkg/distrMod/inst/NEWS
   branches/distr-2.6/pkg/distrMod/man/qqplot.Rd
   branches/distr-2.6/pkg/distrMod/man/returnlevelplot.Rd
Log:
[distrMod] fixed issue with returnlevelplot discovered by B. Spangl -- points had not been ordered;
           qqplot and returnlevelplot both have an additional argument added.points.CI to allow for
           additional evaluation points for the confidence intervals in the range of the seen data

Modified: branches/distr-2.6/pkg/distrMod/R/qqplot.R
===================================================================
--- branches/distr-2.6/pkg/distrMod/R/qqplot.R	2014-08-10 17:00:14 UTC (rev 957)
+++ branches/distr-2.6/pkg/distrMod/R/qqplot.R	2014-08-10 17:26:21 UTC (rev 958)
@@ -74,6 +74,7 @@
              lwd.sCI = 2,         ## line width for the simultaneous CI
              pch.sCI = par("pch"),## symbol for points (for discrete mass points) in simultaneous CI
              cex.sCI = par("cex"),## magnification factor for points (for discrete mass points) in simultaneous CI
+             added.points.CI = TRUE, ## should the CIs be drawn through additional points?
              cex.pch = par("cex"),## magnification factor for the plotted symbols
              col.pch = par("col"),## color for the plotted symbols
              cex.lbl = par("cex"),## magnification factor for the plotted observation labels
@@ -100,6 +101,7 @@
     mcl$withSweave <- NULL
     mcl$mfColRow <- NULL
     mcl$debug <- NULL
+    mcl$added.points.CI <- NULL
     force(x)
 
 
@@ -182,6 +184,13 @@
        if(#is(y,"AbscontDistribution")&&
        withConf){
           xy <- unique(sort(c(x,yc.o)))
+          if(added.points.CI){
+             mxy <- min(xy); Mxy <- max(xy)
+             mnxy <- (mxy+Mxy)/2
+             sxy <- (Mxy-mxy)/2*1.1
+             xyn <- seq(mnxy-sxy,mnxy+sxy,length.out=500)
+             xy <- unique(sort(c(xy,xyn)))
+          }
           xy <- xy[!.NotInSupport(xy,y)]
           lxy <- length(xy)
           if(is(y,"DiscreteDistribution")){

Modified: branches/distr-2.6/pkg/distrMod/R/returnlevelplot.R
===================================================================
--- branches/distr-2.6/pkg/distrMod/R/returnlevelplot.R	2014-08-10 17:00:14 UTC (rev 957)
+++ branches/distr-2.6/pkg/distrMod/R/returnlevelplot.R	2014-08-10 17:26:21 UTC (rev 958)
@@ -48,6 +48,7 @@
              lwd.sCI = 2,         ## line width for the simultaneous CI
              pch.sCI = par("pch"),## symbol for points (for discrete mass points) in simultaneous CI
              cex.sCI = par("cex"),## magnification factor for points (for discrete mass points) in simultaneous CI
+             added.points.CI = TRUE, ## should the CIs be drawn through additional points?
              cex.pch = par("cex"),## magnification factor for the plotted symbols
              col.pch = par("col"),## color for the plotted symbols
              cex.lbl = par("cex"),## magnification factor for the plotted observation labels
@@ -80,13 +81,15 @@
     mcl$mfColRow <- NULL
     mcl$type <-NULL
     mcl$debug <- NULL
+    mcl$added.points.CI <- NULL
     force(x)
 
 
-    xj <- x
-    if(any(.isReplicated(x)))
+    xj <- sort(x)
+    if(any(.isReplicated(x))&&jit.fac>0)
        xj[.isReplicated(x)] <- jitter(x[.isReplicated(x)], factor=jit.fac)
 
+    xj <- sort(xj)
     ord.x <- order(xj)
 
     p2rl <- function(pp){
@@ -94,7 +97,7 @@
                return(if(MaxOrPOT=="Max") -1/log(pp) else  1/(1-pp)/npy)
     }
 
-    pp <- ppoints(n)
+    pp <- ppoints(length(xj))
     yc.o <- q(y)(pp)
     ycl <- p2rl(yc.o)
 
@@ -108,15 +111,15 @@
     rxymean <- (max(xyall)+min(xyall))/2
 
     xyallc  <- seq(from=rxymean-rxyall,to=rxymean+rxyall, length.out=300)
-    print(xyallc)
+#    print(xyallc)
     pxyall  <- p(y)(xyallc)
-    print(pxyall)
+#    print(pxyall)
 
     pxyallc <- p2rl(xyallc)
      xyallc <-  xyallc[pxyall>0.00001 & pxyall<0.99999]
     pxyallc <- pxyallc[pxyall>0.00001 & pxyall<0.99999]
 
-    print(cbind(pxyallc,xyallc))
+#    print(cbind(pxyallc,xyallc))
 
     if("support" %in% names(getSlots(class(y))))
        ycl <- sort(jitter(ycl, factor=jit.fac))
@@ -208,7 +211,12 @@
        qqb <- NULL
        if(#is(y,"AbscontDistribution")&&
        withConf){
-          xy <- unique(sort(c(x,yc.o)))
+
+          if(added.points.CI){
+             xy <- unique(sort(c(x,xj,xyallc,yc.o)))
+          }else{
+             xy <- unique(sort(c(x,xj,yc.o)))
+          }
           xy <- xy[!.NotInSupport(xy,y)]
           lxy <- length(xy)
           if(is(y,"DiscreteDistribution")){
@@ -243,7 +251,7 @@
                   qqb0=qqb, debug = debug)
        }
     }}
-    return(c(ret,qqb))
+    return(invisible(c(ret,qqb)))
     })
 
 ## into distrMod
@@ -255,16 +263,16 @@
     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))
+    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.")
 
-    return(do.call(getMethod("returnlevelplot", signature(x="ANY", y="UnivariateDistribution")),
-            args=mcl))
+    return(invisible(do.call(getMethod("returnlevelplot", signature(x="ANY", y="UnivariateDistribution")),
+            args=mcl)))
     })
 
 setMethod("returnlevelplot", signature(x = "ANY",
@@ -275,8 +283,7 @@
     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))
+    if(missing(xlab)) mc$xlab <- paste(gettext("Return Level of"), as.character(deparse(mc$x)))
     mcl <- as.list(mc)[-1]
 
     param <- ParamFamParameter(main=untransformed.estimate(y), nuisance=nuisance(y),
@@ -292,6 +299,8 @@
 
     PFam0 <- modifyModel(PFam, param)
     mcl$y <- PFam0
-    return(do.call(getMethod("returnlevelplot", signature(x="ANY", y="ProbFamily")),
-            args=mcl))
+    if(missing(ylab)) mc$ylab <- paste(gettext("Return Period at fitted"), name(PFam0))
+
+    return(invisible(do.call(getMethod("returnlevelplot", signature(x="ANY", y="ProbFamily")),
+            args=mcl)))
     })

Modified: branches/distr-2.6/pkg/distrMod/inst/NEWS
===================================================================
--- branches/distr-2.6/pkg/distrMod/inst/NEWS	2014-08-10 17:00:14 UTC (rev 957)
+++ branches/distr-2.6/pkg/distrMod/inst/NEWS	2014-08-10 17:26:21 UTC (rev 958)
@@ -28,6 +28,8 @@
       axis by argument 'datax' for compatibility with other qqplots 
    * gains new methods for object of class "Estimate" (which could also be 
      seen as "fitted" objects...)
+   * additional argument added.points.CI to allow for  additional evaluation 
+     points for the confidence intervals in the range of the seen data	 
 + returnlevelplot
    * similar 
 + new internal method  .checkEstClassForParamFamily-method to be called 
@@ -44,7 +46,7 @@
 + fixed issue with slot withPosRestr in ParamFamParameter.R 
 + fixed issue with check.validity (reported by B.Spangl)
 + fixed some minor issue in existsPIC (in case we get 0 matrix, and less strict tolerance) 
- 
++ fixed issue with returnlevelplot discovered by B. Spangl -- points had not been ordered 
 ##############
 v 2.5
 ##############

Modified: branches/distr-2.6/pkg/distrMod/man/qqplot.Rd
===================================================================
--- branches/distr-2.6/pkg/distrMod/man/qqplot.Rd	2014-08-10 17:00:14 UTC (rev 957)
+++ branches/distr-2.6/pkg/distrMod/man/qqplot.Rd	2014-08-10 17:26:21 UTC (rev 958)
@@ -16,7 +16,7 @@
     col.pCI = "orange", lty.pCI = 3, lwd.pCI = 2, pch.pCI = par("pch"),
     cex.pCI = par("cex"),
     col.sCI = "tomato2", lty.sCI = 4, lwd.sCI = 2, pch.sCI = par("pch"),
-    cex.sCI = par("cex"),
+    cex.sCI = par("cex"), added.points.CI = TRUE,
     cex.pch = par("cex"), col.pch = par("col"),
     cex.lbl = par("cex"), col.lbl = par("col"), adj.lbl = NULL,
     alpha.trsp = NA, jit.fac = 0,
@@ -92,6 +92,8 @@
 \item{pch.sCI}{symbol for points (for discrete mass points) in simultaneous CI}
 \item{cex.sCI}{magnification factor for points (for discrete mass points) in
 simultaneous CI}
+\item{added.points.CI}{logical; should CIs be plotted through additional points
+      (and not only through data points)? }
 \item{cex.pch}{magnification factor for the plotted symbols}
 \item{col.pch}{color for the plotted symbols}
 \item{cex.lbl}{magnification factor for the plotted observation labels}

Modified: branches/distr-2.6/pkg/distrMod/man/returnlevelplot.Rd
===================================================================
--- branches/distr-2.6/pkg/distrMod/man/returnlevelplot.Rd	2014-08-10 17:00:14 UTC (rev 957)
+++ branches/distr-2.6/pkg/distrMod/man/returnlevelplot.Rd	2014-08-10 17:26:21 UTC (rev 958)
@@ -18,7 +18,7 @@
     col.pCI = "orange", lty.pCI = 3, lwd.pCI = 2, pch.pCI = par("pch"),
     cex.pCI = par("cex"),
     col.sCI = "tomato2", lty.sCI = 4, lwd.sCI = 2, pch.sCI = par("pch"),
-    cex.sCI = par("cex"),
+    cex.sCI = par("cex"), added.points.CI = TRUE,
     cex.pch = par("cex"), col.pch = par("col"),
     cex.lbl = par("cex"), col.lbl = par("col"), adj.lbl = NULL,
     alpha.trsp = NA, jit.fac = 0,
@@ -101,6 +101,8 @@
 \item{pch.sCI}{symbol for points (for discrete mass points) in simultaneous CI}
 \item{cex.sCI}{magnification factor for points (for discrete mass points) in
 simultaneous CI}
+\item{added.points.CI}{logical; should CIs be plotted through additional points
+      (and not only through data points)? }
 \item{cex.pch}{magnification factor for the plotted symbols}
 \item{col.pch}{color for the plotted symbols}
 \item{cex.lbl}{magnification factor for the plotted observation labels}



More information about the Distr-commits mailing list