Commit a1d270b8 authored by Jana Ulrich's avatar Jana Ulrich
Browse files

IDF.agg: first rollsum, then get maxima for all months -> saves time

parent e99b28d8
......@@ -16,7 +16,8 @@
#' standard date format.
#' @param ds numeric vector of aggregation durations.
#' (Must be multiples of time resolution at all stations.)
#' @param na.accept numeric giving maximum number of missing values for which annual max. should still be calculated
#' @param na.accept numeric in [0,1] giving maximum percentage of missing values
#' for which block max. should still be calculated
#' @param which.stations optional, subset of stations. Either numeric vector or character vector
#' containing names of elements in data. If not given, all elements in `data` will be used.
#' @param which.mon optional, subset of months of which to calculate the annual maxima from.
......@@ -48,7 +49,7 @@
#'## 3 0.1650978 48 1
#'## 4 0.2356849 48 1
IDF.agg <- function(data,ds,na.accept = 0,
which.stations = NULL,which.mon = 0:11,names = c('date','RR'),cl = NULL){
which.stations = NULL,which.mon = list(0:11),names = c('date','RR'),cl = NULL){
if(!inherits(data, "list"))stop("Argument 'data' must be a list, instead it is a: ", class(data))
......@@ -71,18 +72,21 @@
runsum = RcppRoll::roll_sum(data.s[,names[2]],ds/dtime,fill=NA)
#runmean <- rollapplyr(as.zoo(data.s[,names[2]]),ds/dtime,FUN=sum,fill =NA,align='right')
runsum <- runsum/ds #intensity per hour
subset <- is.element(as.POSIXlt(data.s[,names[1]])$mon,which.mon)
max <- tapply(runsum[subset],(as.POSIXlt(data.s[,names[1]])$year+1900)[subset],
function(vec){
n.na <- sum(is.na(vec))
max <- ifelse(n.na <= na.accept,max(vec,na.rm = TRUE),NA)
return(max)})
df <- data.frame(xdat=max,ds=ds,year=as.numeric(names(max)))
max.subset <- lapply(1:length(which.mon),function(m.i){
subset <- is.element(as.POSIXlt(data.s[,names[1]])$mon,which.mon[[m.i]])
max <- tapply(runsum[subset],(as.POSIXlt(data.s[,names[1]])$year+1900)[subset],
function(vec){
n.na <- sum(is.na(vec))
max <- ifelse(n.na <= na.accept*length(vec),max(vec,na.rm = TRUE),NA)
return(max)})
df <- data.frame(xdat=max,ds=ds,year=as.numeric(names(max)),mon=deparse(which.mon[[m.i]]),
stringsAsFactors = FALSE)
return(df)})
df <- do.call(rbind,max.subset)
return(df) # maxima for single durations
}
# call function 1 in lapply to aggregate over all durations at single station
data.agg <- pbapply::pblapply(ds,agg.ts,cl=cl)
#browser()
data.agg <- pbapply::pblapply(ds,agg.ts,cl=cl) #
df <- do.call(rbind,data.agg)
return(df) # maxima for all durations at one station
}
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment