added confidence intervals to diagnostic plotting function

DESCRIPTION

 Package: IDF
 Type: Package
 Title: Estimation and Plotting of IDF Curves
-Version: 2.1.0
-Date: 2021-04-07
+Version: 2.1.0.9000
+Date: 2021-05-12
 Authors@R: c(person("Jana", "Ulrich", email = "jana.ulrich@met.fu-berlin.de", role = c("aut", "cre")),
 	    person("Laura","Mack", email= "laura.mack@fu-berlin.de",role="ctb"),
 	    person("Oscar E.","Jurado", email= "jurado@zedat.fu-berlin.de",role="ctb"),

NEWS.md

+# IDF 2.1.0.9000
+
+- added confidence intervals for diagnostic plots (gev.d.diag)
+
+
 # IDF 2.1.0
 
 ## New features:

R/gevdfit.R

@@ -479,11 +479,13 @@ gev.d.lik <- function(xdat,ds,mut,sigma0,xi,theta,eta,log=FALSE,tau=0,eta2=NULL)
 #' @param legend logical indicating if legends should be plotted
 #' @param title character vector of length 2, giving the titles for the pp- and the qq-plot
 #' @param emp.lab,mod.lab character string containing names for empirical and model axis
+#' @param ci logical indicating whether 0.95 confidence intervals should be plotted
 #' @param ... additional parameters passed on to the plotting function
 #'
 #' @export
 #' @importFrom graphics plot abline par title
 #' @importFrom grDevices rainbow
+#' @importFrom evd rgev
 #'
 #' @examples
 #' data('example',package ='IDF')
@@ -496,10 +498,10 @@ gev.d.lik <- function(xdat,ds,mut,sigma0,xi,theta,eta,log=FALSE,tau=0,eta2=NULL)
 #' gev.d.diag(fit,subset = example$cov1==1,pch=1)
 gev.d.diag <- function(fit,subset=NULL,cols=NULL,pch=NULL,which='both',mfrow=c(1,2),legend=TRUE,
                        title=c('Residual Probability Plot','Residual Quantile Plot'),
-                       emp.lab='Empirical',mod.lab='Model',...){
+                       emp.lab='Empirical',mod.lab='Model',ci=FALSE,...){
   # check parameter:
   if(!is.element(which,c('both','pp','qq'))) stop("Parameter 'which'= ",which,
-                                                 " but only 'both','pp' or 'qq' are allowed.")
+                                                  " but only 'both','pp' or 'qq' are allowed.")
   # subset data
   df <- data.frame(data=fit$data,ds=fit$ds)
   if(!is.null(subset)){
@@ -511,34 +513,50 @@ gev.d.diag <- function(fit,subset=NULL,cols=NULL,pch=NULL,which='both',mfrow=c(1
   durs <- sort(unique(df$ds))
   # rescale durations to assign colors
   df$cval <- sapply(df$ds,function(d){which(durs==d)})
-
+  
   # sort data
   df <- df[order(df$data),]
-
+  
   # plotting position
   n <- length(df$data)
   px <- (1:n)/(n + 1)
-
+  
+  # get 95% confidence intervals
+  if(ci){
+    samp <- rgev(n * 99, loc = 0, scale = 1, shape = 0)
+    samp <- matrix(samp, n, 99)
+    samp <- apply(samp, 2, sort)
+    samp <- apply(samp, 1, sort)
+    ci.vals <- t(samp[c(3, 97), ])
+  }else{ci.vals <- NULL}
   # create plots:
   if(which=='both') par(mfrow=mfrow) # 2 subplots
   # colors and symbols
   if(is.null(cols))cols <- rainbow(length(durs))
   if(is.null(pch))pch <- df$cval
-
+  
   if(which=='both'|which=='pp'){
     # pp
-    plot(px, exp( - exp( - df$data)), xlab =
-           emp.lab, ylab = mod.lab,col=cols[df$cval],pch=pch,...)
+    plot(px, exp( - exp( - df$data)), xlab = emp.lab, ylab = mod.lab,col=cols[df$cval]
+         ,pch=pch,ylim=range(exp( - exp(-c(ci.vals,df$data))),na.rm = TRUE),...)
     abline(0, 1, col = 1,lwd=1)
+    if(ci){
+      lines(px,exp( - exp( - ci.vals[,1])),lty=2)
+      lines(px,exp( - exp( - ci.vals[,2])),lty=2)
+    }
     title(title[1])
     if(legend){legend('bottomright',legend = round(durs,digits = 2),pch=pch,
                       col = cols[1:length(durs)],title = 'Duration [h]',ncol = 2)}
   }
   if(which=='both'|which=='qq'){
     # qq
-    plot( - log( - log(px)), df$data, ylab =
-            emp.lab, xlab = mod.lab,col=cols[df$cval],pch=pch,...)
+    plot( - log( - log(px)), df$data, ylab = emp.lab, xlab = mod.lab,col=cols[df$cval]
+          ,pch=pch,ylim=range(c(ci.vals,df$data),na.rm = TRUE),...)
     abline(0, 1, col = 1,lwd=1)
+    if(ci){
+      lines(-log(-log(px)),ci.vals[,1],lty=2)
+      lines(-log(-log(px)),ci.vals[,2],lty=2)
+    }
     title(title[2])
     if(legend){legend('bottomright',legend = round(durs,digits = 2),pch=pch,
                       col = cols[1:length(durs)],title = 'Duration [h]',ncol = 2)}
@@ -546,6 +564,7 @@ gev.d.diag <- function(fit,subset=NULL,cols=NULL,pch=NULL,which='both',mfrow=c(1
   if(which=='both') par(mfrow=c(1,1)) # reset par
 }
 
+
 #### gev.d.params ####
 
 #' Calculate gev(d) parameters from \code{gev.d.fit} output

man/gev.d.diag.Rd

@@ -15,6 +15,7 @@ gev.d.diag(
   title = c("Residual Probability Plot", "Residual Quantile Plot"),
   emp.lab = "Empirical",
   mod.lab = "Model",
+  ci = FALSE,
   ...
 )
 }
@@ -41,6 +42,8 @@ set to \code{c(1,1)}.}
 
 \item{emp.lab, mod.lab}{character string containing names for empirical and model axis}
 
+\item{ci}{logical indicating whether 0.95 confidence intervals should be plotted}
+
 \item{...}{additional parameters passed on to the plotting function}
 }
 \description{