#'Compute persistence 
#'
#'Compute a persistence forecast based on a lagged autoregression of 
#'observational data along the time dimension, with a measure of forecast 
#'uncertainty (prediction interval) based on Coelho et al., 2004.\cr\cr
#'
#'@param data A numeric array corresponding to the observational data
#'  including the time dimension along which the autoregression is computed. The data
#'  should start at least 40 years before 'sdate_beg'.
#'@param time_dim A character string indicating the dimension along which to 
#'  compute the autoregression. The default value is 'sdate'.
#'@param sdate_beg A 4-digit integer indicating the first start date of the persistence
#'  forecast.
#'@param sdate_end A 4-digit integer indicating the last start date of the persistence
#'  forecast.
#'@param fyr_beg An integer indicating the forecast year for which
#'  the persistence forecast should be calculated, or the first forecast
#'  year of the average forecast years for which persistence should be
#'  calculated.
#'@param fyr_end An (optional) integer indicating the last forecast year
#'  of the average forecast years for which persistence should be calculated
#'  in the case of a multiyear average persistence. The default value is 'fyr_beg'.
#'@param dates A sequence of 4-digit integers indicating the dates available
#'  in the observations.
#'@param memb An integer indicating the number of ensemble members to
#'  generate for the persistence forecast. The default value is 1.
#'@param na.action A function or an integer. A function (e.g., na.omit, 
#'  na.exclude, na.fail, na.pass) indicates what should happen when the data 
#'  contain NAs. A numeric indicates the maximum number of NA position allowed to
#'  compute regression. The default value is 10.
#'@param ncores An integer indicating the number of cores to use for parallel
#'  computation. The default value is NULL.
#'
#'@return 
#'A list containing:
#'\item{$persistence}{
#'  A numeric array with dimensions 'memb', start dates, latitudes and longitudes
#'  containing the persistence forecast.   
#'}
#'\item{$persistence.mean}{
#'  A numeric array with same dimensions as 'persistence', except the 'memb' dimension
#'  which is of length 1, containing the ensemble mean persistence forecast.
#'}
#'\item{$persistence.predint}{
#'  A numeric array with same dimensions as 'persistence', except the 'memb' dimension
#'  which is of length 1, containing the prediction interval of the persistence forecast.
#'}
#'\item{$AR.slope}{
#'  A numeric array with same dimensions as 'persistence', except the 'memb' dimension
#'  which is of length 1, containing the slope coefficient of the autoregression.
#'}
#'\item{$AR.intercept}{
#'  A numeric array with same dimensions as 'persistence', except the 'memb' dimension
#'  which is of length 1, containing the intercept coefficient of the autoregression.
#'}
#'\item{$AR.lowCI}{
#'  A numeric array with same dimensions as 'persistence', except the 'memb' dimension
#'  which is of length 1, containing the lower value of the confidence interval of the
#'  autoregression.
#'}
#'\item{$AR.highCI}{
#'  A numeric array with same dimensions as 'persistence', except the 'memb' dimension
#'  which is of length 1, containing the upper value of the confidence interval of the
#'  autoregression.
#'}
#'
#'@examples
#'#Building an example dataset with yearly start dates from 1920 to 2009
#'obs1 <- 1 : (1 * 1 * 90 * 6 * 7)
#'dim(obs1) <- c(dataset = 1, member = 1, sdate = 90, lat = 6, lon = 7)
#'dates <- seq(1920,2009,1)
#'lon <- seq(0, 30, 5)
#'lat <- seq(0, 25, 5)
#'obs <- list(data = obs1, dates = dates, lat = lat, lon = lon)
#'persist <- Persistence(obs, sdate_beg = 1961, sdate_end = 2005, fyr_beg = 1,
#'                       dates = dates, memb = 40)
#'
#'@rdname Persistence
#'@import multiApply
#'@import abind
#'@export
Persistence <- function(data, time_dim = 'sdate', sdate_beg, sdate_end, fyr_beg, 
                  fyr_end = fyr_beg, dates, memb = 1, na.action = 10, ncores = NULL) {

  # Check inputs 
  ## data
  if (is.null(data)) {
    stop("Parameter 'data' cannot be NULL.")
  }
  if (!is.numeric(data)) {
    stop("Parameter 'data' must be a numeric array.")
  }
  if (is.null(dim(data))) {  #is vector
    dim(data) <- c(length(data))
    names(dim(data)) <- time_dim
  }
  if(any(is.null(names(dim(data))))| any(nchar(names(dim(data))) == 0)) {
    stop("Parameter 'data' must have dimension names.")
  }
  ## time_dim
  if (!is.character(time_dim) | length(time_dim) > 1) {
    stop("Parameter 'time_dim' must be a character string.")
  }
  if (!time_dim %in% names(dim(data))) {
    stop("Parameter 'time_dim' is not found in 'data' dimension.")
  }
  ## sdate_beg
  if (!is.numeric(sdate_beg) | sdate_beg %% 1 != 0 | sdate_beg < 0 |
      length(sdate_beg) > 1) | sdate_beg < 1850 | sdate_beg > 2020 {
    stop("Parameter 'sdate_beg' must be an integer between 1850 and 2020.")
      }
  if (sdate_beg < sdates[1]+40 {
        stop("Parameter 'sdate_beg' must start at least 40 years after the 
             first start date of 'data'.")
      }
  ## sdate_end
  if (!is.numeric(sdate_end) | sdate_end %% 1 != 0 | sdate_end < 0 |
      length(sdate_end) > 1) | sdate_end < 1850 | sdate_end > 2020 {
    stop("Parameter 'sdate_end' must be an integer between 1850 and 2020.")
      }
  if (sdate_end > sdates[length(sdates)]+1 {
    stop("Parameter 'sdate_end' must end at most 1 year after the 
             last start date of 'data'.")
  }
  ## fyr_beg
  if (!is.numeric(fyr_beg) | fyr_beg %% 1 != 0 | fyr_beg < 0 |
      length(fyr_beg) > 1) {
    stop("Parameter 'fyr_beg' must be a positive integer.")
  }
  ## fyr_end
  if (!is.numeric(fyr_end) | fyr_end %% 1 != 0 | fyr_end < 0 |
      length(fyr_end) > 1) | fyr_end > 10 {
    stop("Parameter 'fyr_end' must be a positive integer below 10.")
      }
  ## dates
  if (length(dates) != length(data[[2]])) {
    stop("Parameter 'dates' must have the same length as in 'time_dim'.")
  }
  ## memb
  if (!is.numeric(memb) | memb %% 1 != 0 | memb < 0 |
      length(memb) > 1) {
    stop("Parameter 'memb' must be a positive integer.")
  }
  ## na.action
  if (!is.function(na.action) & !is.numeric(na.action)) {
    stop(paste0("Parameter 'na.action' must be a function for NA values or ",
                "a numeric indicating the number of NA values allowed ",
                "before returning NA."))
  }
  if (is.numeric(na.action)) {
    if (any(na.action %% 1 != 0) | any(na.action < 0) | length(na.action) > 1) {
      stop(paste0("Parameter 'na.action' must be a function for NA values or ",
                  "a numeric indicating the number of NA values allowed ",
                  "before returning NA."))
    }
  }
  ## ncores
  if (!is.null(ncores)) {
    if (!is.numeric(ncores) | ncores %% 1 != 0 | ncores < 0 |
      length(ncores) > 1) {
      stop("Parameter 'ncores' must be a positive integer.")
    }
  }

  ###############################
  # Calculate Persistence
  dim_names <- names(dim(data))


  output <- Apply(list(data),
                  target_dims = time_dim,
                  fun = .Persistence,
                  output_dims = output_dims,
                  time_dim = time_dim,
                  sdate_beg = sdate_beg,
                  sdate_end = sdate_end,
                  fyr_beg = fyr_beg,
                  fyr_end = fyr_end,
                  dates = dates,
                  memb = memb, 
                  na.action = na.action,
                  ncores = ncores)

  return(output)
}

.Persistence <- function(x, time_dim = 'sdate', sdate_beg, sdate_end, fyr_beg, 
           fyr_end = fyr_beg, dates = dates, memb = 1, na.action = 10) {

  tm <- sdate_end - sdate_beg + 1
  latl <- length(x$lat)
  lonn <- length(x$lon)
  max_date <- match(sdate_beg,dates)
  interval <- fyr_end - fyr_beg
  persistence <- array(NA,dim=c(memb,tm,latl,lonn))
  persistence.mean <- array(NA,dim=c(tm,latl,lonn))
  persistence.predint <- array(NA,dim=c(tm,latl,lonn))
  AR.slope <- array(NA,dim=c(tm,latl,lonn))
  AR.intercept <- array(NA,dim=c(tm,latl,lonn))
  AR.lowCI <- array(NA,dim=c(tm,latl,lonn))
  AR.highCI <- array(NA,dim=c(tm,latl,lonn))


  for (sdate in tm:1){
  min_y = 10 + fyr_beg
  max_y = max_date + sdate - 2
  min_x = 10        # for extreme case: forecast years 1-10, interval = 9
  max_x = max_date + sdate - 2 -fyr_beg

  regdates = max_y - min_y + 1

  for (longi in 1:lonn){   # Global
  for (lati in 1:latl){   # Global
   for (val_x in min_x:max_x){
     tmp_x <- mean(x$data[,,(val_x-interval):val_x,lati,longi])
     if (val_x == min_x){
       obs_x <- tmp_x
     }else{
       obs_x <- abind(obs_x,tmp_x,along=1)
     }
   }

   for (val_y in min_y:max_y){
     tmp_y <- mean(x$data[,,val_y:(val_y+interval),lati,longi])
     if (val_y == min_y){
       obs_y <- tmp_y
     }else{
       obs_y <- abind(obs_y,tmp_y,along=1)
     }
   }

     y_axis <- obs_y
     x_axis <- obs_x
     dim(y_axis) <- c(time = regdates)
     dim(x_axis) <- c(time = regdates)
     reg <- Regression(y_axis, x_axis, posREG = 'time', na.action = na.action)
     len <- length(obs_x)
     a <- reg$regression[2] # slope
     b <- reg$regression[4] # intercept
     CI <- abs(reg$regression[3] - reg$regression[1]) # confidence interval
     stdev_reg <- CI / 1.96
     n <- max_x
     X_sq <- (obs_x[len] - mean(obs_x))**2
     S_sq <- sum((obs_x[1:len] - mean(obs_x))**2)

     persistence.mean[sdate,lati,longi] <- a * mean(x$data[,,(max_y-interval):max_y,lati,longi]) + b
     persistence.predint[sdate,lati,longi] <- stdev_reg * sqrt(1 + 1/n + X_sq/S_sq)
     AR.slope[sdate,lati,longi] <- a
     AR.intercept[sdate,lati,longi] <- b
     AR.lowCI[sdate,lati,longi] <- reg$regression[1]
     AR.highCI[sdate,lati,longi] <- reg$regression[3]
     persistence[,sdate,lati,longi] <- rnorm(n=memb,mean=persistence.mean[sdate,lati,longi],
                                             sd=persistence.predint[sdate,lati,longi])
     
  }
  }

  }

  return(list(persistence = persistence, persistence.mean = persistence.mean, 
              persistence.predint = persistence.predint, AR.slope = AR.slope,
              AR.intercept = AR.intercept, AR.lowCI = AR.lowCI,
              AR.highCI = AR.highCI))

}
