R/frequency.R

In metno/esd: Climate analysis and empirical-statistical downscaling (ESD) package for monthly and daily data

## Author : A. Mezghani
## used in check.ncdf4()

#' Full time frequency names
#' @export
frequency.name <- c("year","season","month","day","hours","minutes","seconds")

#' Abbreviated time frequency names
#' @export
frequency.abb  <-  substr(tolower(frequency.name),1,3)

#' Calculate the frequency
#'
#' @param data input object containing a time index
#' @param unit unit of time index in 'data'
#'
#' @export
datafrequency <- function(data=NULL,unit=NULL,verbose=FALSE) {
  if (is.null(data) | is.null(unit)) stop("Both data and unit are mandatory inputs !")
  # Initialize
  freq <- NULL
  # compute interval
  # Automatic detection 
  if (!is.null(unit) & length(data)>1) {
    dt <- round(median(diff(data),na.rm=TRUE))
    if(dt==0) dt <- median(diff(data),na.rm=TRUE)
    unit <- substr(tolower(unit),1,3)
    if ( ((dt>=360) & grepl("day",unit)) | (dt==12) & grepl("mon",unit)) {
      freq <- "year"
    } else if (((dt==3) & grepl("mon",unit)) |  ((dt<93) & (dt>88) & grepl("day",unit)) |
               ((dt<2209) & (dt>2159) & grepl("hou",unit)) |
               ((dt>=60*60*24*(29+30+31) & dt<=60*60*24**(31+31+30)) & grepl("sec",unit)) ) {
      freq <- "season"
    } else if ((((dt==31) | (dt==30)) & grepl("day",unit)) |
        ((dt==1) & grepl("mon",unit)) |
        ((dt>=672 & dt<=744) & grepl("hou",unit)) |
	      (((dt==31) | (dt==1440) | (dt==44640)) & grepl("min",unit)) |
        ((dt>=60*60*24*28 & dt<=60*60*24*31) & grepl("sec",unit)) ) {
      freq <- "month"
    } else if ((dt==14) & grepl("day",unit)) {
      freq <- "2weeks"
    } else if ((dt==7) & grepl("day",unit)) {
      freq <- "week"
    } else if (((dt==1) & grepl("day",unit)) | ((dt==24) & grepl("hou",unit))) {
      freq <- "day"
    } else if (((dt==1) & grepl("hou",unit)) | ((dt==3600) & grepl("hou",unit)) |
               ((dt==60*60*24) & grepl("sec",unit))) {
      freq <- "hour"
    } else if((dt>1) & grepl("hou",unit)) {
      freq <- paste(dt,"hour",sep="")
    } else if(dt<1 & grepl("day",unit)) {
      freq <- paste(round(dt*24),"hour",sep="")
    } else if(grepl("sec",unit)) {
      if(dt < 60) freq <- paste(dt,"sec",sep="") else 
        freq <- paste(round(dt/(60*60)),"hour",sep="") 
    } else if(grepl("min",unit)) {
      if(dt < 60) freq <- paste(dt,"min",sep="") else
        if(dt>=60 & dt<(24*60)) freq <- paste(round(dt/60),"hour",sep="") else
          if(dt>=(24*60)) freq <- paste(round(dt/(60*24),"day",sep=""))
    }
  } 
  if (is.null(freq)) {
    # User entry
    if (verbose) print("Frequency could not be set automatically !")
    print(paste(as.character(seq(1,length(frequency.name),1)),frequency.name,sep=":"))
    ifreq <- as.integer(readline("Please select a frequency number from the list before continue and press Enter:"))   
    if (!is.na(ifreq)) {
      freq <- frequency.abb[ifreq]
    } else {
      stop("You must provide an integer from the list !")
    }
    if (is.null(freq)) stop("Process is stopped: User should provide the frequency before continuing !")
  }
  return(freq)
}