HR and KK did some small changes: a) add ... to plotting functions, b) add ......

HR and KK did some small changes: a) add ... to plotting functions, b) add ... to pass arguments to control of optim c) small others

DESCRIPTION

 Package: IDF
 Type: Package
 Title: Estimation and Plotting of IDF Curves
-Version: 1.2
-Date: 2018-01-22
+Version: 1.3
+Date: 2018-02-06
 Author: Christoph Ritschel, Carola Detring, Sarah Joedicke
 Maintainer: Christoph Ritschel <christoph.ritschel@met.fu-berlin.de>
 Description: Intensity-duration-frequency (IDF) curves are a widely used analysis-tool in hydrology to assess extreme values of precipitation [e.g. Mailhot et al., 2007, <doi:10.1016/j.jhydrol.2007.09.019>]. The package 'IDF' provides a function to read precipitation data from German weather service (DWD) 'webwerdis' <http://www.dwd.de/EN/ourservices/webwerdis/webwerdis.html> files and Berlin station data from 'Stadtmessnetz' <http://www.geo.fu-berlin.de/en/met/service/stadtmessnetz/index.html> files, and additionally IDF parameters can be estimated also from a given data.frame containing a precipitation time series. The data is aggregated to given levels yearly intensity maxima are calculated either for the whole year or given months. From these intensity maxima IDF parameters are estimated on the basis of a duration-dependent generalised extreme value distribution [Koutsoyannis et al., 1998, <doi:10.1016/S0022-1694(98)00097-3>]. IDF curves based on these estimated parameters can be plotted.

R/IDF.R

@@ -313,7 +313,7 @@ IDF.nll <- function(mu=0,sigma=1,xi=0,theta=0,eta=1,x,d,use.log=F,DEBUG=F) {
 #' @return $par vector of IDF parameters at optimization minimum
 #' @author Christoph Ritschel \email{christoph.ritschel@@met.fu-berlin.de}
 
-fit.fun <- function(obs,dur,mu=1,sigma=1,xi=0.5,theta=1,eta=1,use.log=F,DEBUG=F,method="Nelder-Mead",upper=Inf,lower=-Inf) {
+fit.fun <- function(obs,dur,mu=1,sigma=1,xi=0.5,theta=1,eta=1,use.log=F,DEBUG=F,method="Nelder-Mead",upper=Inf,lower=-Inf,...) {
   
   use.log=use.log
   
@@ -339,7 +339,7 @@ fit.fun <- function(obs,dur,mu=1,sigma=1,xi=0.5,theta=1,eta=1,use.log=F,DEBUG=F,
   
   ## check initial value of negative log-Likelihood function
   nll <- IDF.nll(mu,sigma,xi,theta,eta,x=obs,d=dur,use.log=use.log,DEBUG=DEBUG)
-  
+
   ## if initial value is acceptable...
   if(!is.infinite(nll)&!is.na(nll)) {
     
@@ -349,7 +349,7 @@ fit.fun <- function(obs,dur,mu=1,sigma=1,xi=0.5,theta=1,eta=1,use.log=F,DEBUG=F,
       ## problem: optimization algrorithm often has difficulities concerning infinite or NA-difference values betweeen iterations
       ## solution: ignore this error message using functon tryCatch and return NULL if there was an error during optimization
       fit <- tryCatch(mle(IDF.nll,start=list(mu=mu,sigma=sigma,xi=xi,theta=theta,eta=eta),fixed=list(x=obs,d=dur,use.log=use.log,DEBUG=DEBUG),
-                          control=list(trace=0,maxit=5000),
+                          control=list(...),
                           method=method,upper=upper,lower=lower), error=function(e) NULL)#,
       #upper=upper,lower=lower)
       
@@ -358,7 +358,7 @@ fit.fun <- function(obs,dur,mu=1,sigma=1,xi=0.5,theta=1,eta=1,use.log=F,DEBUG=F,
       ## problem: optimization algrorithm often has difficulities concerning infinite or NA-difference values betweeen iterations
       ## solution: ignore this error message using functon tryCatch and return NULL if there was an error during optimization
       fit <- tryCatch(mle(IDF.nll,start=list(mu=mu,sigma=sigma,xi=xi,theta=theta,eta=eta),fixed=list(x=obs,d=dur,use.log=use.log,DEBUG=DEBUG),
-                          control=list(trace=0,maxit=5000),
+                          control=list(...),
                           method=method), error=function(e) NULL)#,
       #upper=upper,lower=lower)
       
@@ -572,7 +572,7 @@ IDF.init <- function(int.vec,durs,n.y,method="Nelder-Mead") {
 
 IDF <- function(data,agg.lev=c(2,3,6,12,24,48,72,96),month="all",moving.sum="FALSE",mu.init=NA,sigma.init=NA,xi.init=NA,theta.init=0,eta.init=NA,
                 use.log=FALSE,DEBUG=FALSE,method="Nelder-Mead",upper=Inf,lower=-Inf,plot=FALSE,
-                probs=c(0.5,0.9,0.99),cols=c(rgb(1,0,0,1),rgb(0,1,0,1),rgb(0,0,1,1)),station.name="Berlin",data.name="obs") {
+                probs=c(0.5,0.9,0.99),cols=c(rgb(1,0,0,1),rgb(0,1,0,1),rgb(0,0,1,1)),station.name="Berlin",data.name="obs",...) {
   
   #########################################################################
   ### Calculate extreme values for each year and each aggregation level ###
@@ -600,7 +600,7 @@ IDF <- function(data,agg.lev=c(2,3,6,12,24,48,72,96),month="all",moving.sum="FAL
   ######################################################
   if(!is.na(mu.init) | !is.na(sigma.init) | !is.na(xi.init) | !is.na(eta.init)) {
     fit <- fit.fun(obs=int.vec,dur=durs,mu=mu.init,sigma=sigma.init,xi=xi.init,theta=theta.init,eta=eta.init,use.log=use.log,
-                   DEBUG=DEBUG,method=method,upper=upper,lower=lower)
+                   DEBUG=DEBUG,method=method,upper=upper,lower=lower,...)
   }else {
     cat("Warning: Optimization not carried out due to invalid initial values. \n")
     fit.min <- NA
@@ -673,7 +673,8 @@ IDF <- function(data,agg.lev=c(2,3,6,12,24,48,72,96),month="all",moving.sum="FAL
 
 IDF.short <- function(int.vec,durs,n.y,mu.init=NA,sigma.init=NA,xi.init=NA,theta.init=0,eta.init=NA,
                       use.log=FALSE,DEBUG=FALSE,method="Nelder-Mead",upper=Inf,lower=-Inf,plot=FALSE,
-                      probs=c(0.5,0.9,0.99),cols=c(rgb(1,0,0,1),rgb(0,1,0,1),rgb(0,0,1,1)),station.name="Berlin",data.name="obs") {
+                      probs=c(0.5,0.9,0.99),cols=c(rgb(1,0,0,1),rgb(0,1,0,1),rgb(0,0,1,1)),
+                      station.name="Station",data.name="obs",...) {
   
   ###################################################################################
   ### Estimate Parameters for single duration if not given initial values by user ###
@@ -690,9 +691,9 @@ IDF.short <- function(int.vec,durs,n.y,mu.init=NA,sigma.init=NA,xi.init=NA,theta
   ######################################################
   ### Estimate parameters for duration-dependent GEV ###
   ######################################################
-  if(!is.na(mu.init) | !is.na(sigma.init) | !is.na(xi.init) | !is.na(eta.init)) {
+    if(!is.na(mu.init) | !is.na(sigma.init) | !is.na(xi.init) | !is.na(eta.init)) {
     fit <- fit.fun(obs=int.vec,dur=durs,mu=mu.init,sigma=sigma.init,xi=xi.init,theta=theta.init,eta=eta.init,use.log=use.log,
-                   DEBUG=DEBUG,method=method,upper=upper,lower=lower)
+                   DEBUG=DEBUG,method=method,upper=upper,lower=lower,...)
   }else {
     cat("Warning: Optimization not carried out due to invalid initial values. \n")
     fit.min <- NA
@@ -744,7 +745,10 @@ IDF.short <- function(int.vec,durs,n.y,mu.init=NA,sigma.init=NA,xi.init=NA,theta
 #' IDF.plot(pars=param,st.name="example",dt.name="rgamma")
 #' @author Christoph Ritschel \email{christoph.ritschel@@met.fu-berlin.de}
 
-IDF.plot <- function(pars,probs=c(0.5,0.9,0.99),dur=c(0.5,1,2,3,6,12,24,48,72,96),cols=c(rgb(1,0,0,1),rgb(0,1,0,1),rgb(0,0,1,1)),st.name="Berlin-Dahlem",dt.name="obs",ints=NA,ds=NA) {
+IDF.plot <- function(pars,probs=c(0.5,0.9,0.99),
+                     dur=c(0.5,1,2,3,6,12,24,48,72,96),
+                     cols=rainbow(length(probs)),lty=1,
+                     st.name="Station",dt.name="obs",ints=NA,ds=NA,ylim=NA,add=FALSE,...) {
   
   ## initialize array for IDF values at different durations and for different probabilities
   idf.array <- array(NA,dim=c(length(dur),length(probs)))
@@ -756,25 +760,26 @@ IDF.plot <- function(pars,probs=c(0.5,0.9,0.99),dur=c(0.5,1,2,3,6,12,24,48,72,96
     idf.array[,i] <- qgev.d(probs[i],mu=pars[1],sigma=pars[2],xi=pars[3],theta=pars[4],eta=pars[5],d=dur)
     
   } ## end of loop over probs
-  
-  ## initiialize plot window with limits of IDF values
-  plot(NA,axes=F,xlim=c(min(dur,na.rm=T),max(dur,na.rm=T)),ylim=c(min(idf.array[,1],na.rm=T),max(idf.array[,3],na.rm=T)),xlab="duration [h]",ylab="intensity [mm/h]",log="xy")
-  axis(1,at=dur,labels=dur)
-  axis(2)  
-  points(ds,ints,pch=16,col=rgb(0,0,0,0.5))
-  
-  ## loop over probabilities
-  ## plot IDF curve
-  for(i in 1:length(probs)) {
-    points(dur,idf.array[,i],type="l",col=cols[i],lwd=1.5)
-  } 
-  
-  legend.text.2 <- "quantile"
-  
-  ## plot legend
-  legend(x="topright",legend=c(st.name,dt.name,paste(probs,legend.text.2,sep=" ")),
-         col=c(1,rgb(0,0,0,0.5),cols),lty=c(NA,NA,rep(1,length(cols))),pch=c(NA,16,rep(NA,length(cols))))
-  
+    if(!add){
+        ## initiialize plot window with limits of IDF values
+        y.range <- ifelse(is.na(ylim), c(min(idf.array[,1],na.rm=T),max(idf.array[,3],na.rm=T)),ylim)
+        plot(NA,axes=F,xlim=c(min(dur,na.rm=T),max(dur,na.rm=T)),ylim=y.range,xlab="duration [h]",ylab="intensity [mm/h]",log="xy",...)
+        axis(1,at=dur,labels=dur)
+        axis(2)  
+        points(ds,ints,pch=16,col=rgb(0,0,0,0.5))
+        ## loop over probabilities
+        ## plot IDF curve
+        
+        legend.text.2 <- "quantile"
+        
+        ## plot legend
+        legend(x="topright",legend=c(st.name,dt.name,paste(probs,legend.text.2,sep=" ")),
+               col=c(1,rgb(0,0,0,0.5),cols),lty=c(NA,NA,rep(1,length(cols))),pch=c(NA,16,rep(NA,length(cols))))
+    }
+    
+    for(i in 1:length(probs)) 
+        lines(dur,idf.array[,i],col=cols[i],lwd=1.5,lty=lty)
+        
 } ## end of function IDF.plot
 ###################################################################################