#'Computes Seasonal Means
#'
#'Computes seasonal means (or other operations) on monthly timeseries from n-dimensional arrays with named dimensions
#'
#'@param var a numeric n-dimensional array with named dimensions on monthy frequency. 
#'@param posdim a character indicating the name of the dimension or a integer numeric indicating the position along which to compute seasonal means (or other operations). By default, 'time' dimension is expected.
#'@param monini an integer indicating the first month of the time series: 1 to 12.
#'@param moninf an integer indicating the month when to start the seasonal means: 1 to 12.
#'@param monsup an integer indicating the month when to stop the seasonal means: 1 to 12.
#'@param operation a character or function indicating the name of a function to be applied in seasonal basins. By default, means are computed. Other operations can be 'sum' for total precipitation.
#'@param na.rm a logical value indicating whether NA values should be stripped before the computation proceeds.
#'
#'@return Array with the same dimensions as var except along the posdim dimension whose length corresponds to the number of seasons. Partial seasons are not accounted for.
#'
#'@import multiApply
#'@examples
#'dat <- 1 : (12 * 5 * 2 * 3 * 2)
#'dim(dat) <- c(dat = 1, memb = 3, time = 12 * 5, lon = 2, lat = 2) 
#'res <- Season(var = dat, monini = 1, moninf = 1, monsup = 2)
#'dat <- 1 : (12 * 2 * 3)
#'dim(dat) <- c(dat = 2, time = 12, memb = 3)
#'res <- Season(var = dat, monini = 1, moninf = 1, monsup = 2)
#'dat <- 1 : (24 * 2 * 3)
#'dim(dat) <- c(dat = 2, time = 24, memb = 3)
#'res <- Season(var = dat, monini = 1, moninf = 1, monsup = 2)
#'dat[c(1, 20, 50)] <- NA
#'res1 <- Season(var = dat, monini = 1, moninf = 1, monsup = 2, na.rm = FALSE)
#'res2 <- Season(var = dat, monini = 1, moninf = 1, monsup = 2, na.rm = TRUE)
#'@export
Season_new <- function(var, posdim = 'time', monini, moninf, monsup, 
                   operation = mean, na.rm = FALSE) {
    # Check var
    if (is.null(var)) {
        stop("Parameter 'var' cannot be NULL.")
    }
    if (!is.numeric(var)) {
        stop("Parameter 'var' must be a numeric array.")
    }
    if (is.null(dim(var))) {
        dim(var) <- c(length(var))
        if (is.character(posdim)) {
            names(dim(var)) <- posdim
        } else {
            names(dim(var)) <- 'time'
            posdim <- 'time'
        }
        time_dim <- 1
    } else {
        if (is.null(names(dim(var)))) {
             if (is.numeric(posdim)) {
                names(dim(var)) <- paste0("D", 1 : length(dim(var)))  
                names(dim(var))[posdim] <- 'time'
                time_dim <- posdim
                posdim <- 'time'
            } else  {
                stop("Parameter 'var' must contain dimesnion names.")
            }
        } else {
             if (is.numeric(posdim)) {
                time_dim <- posdim 
                posdim <- names(dim(var))[posdim]
             } else if (is.character(posdim)) {
                 time_dim <- which(names(dim(var)) == posdim)
             } else {
                stop("Parameter 'posdim' must be an integer or character",
                     "indicating the 'time' dimension.")
            }
        }
    }

    dim_names <- names(dim(var))
#    series <- apply(var, margins, .Season, 
#                    monini = monini, moninf = moninf, monsup = monsup,
#                    operation = operation)
    series <- Apply(list(var), 
                    target_dims = posdim, 
                    fun = .Season, 
                    monini = monini, moninf = moninf, monsup = monsup,
                    operation = operation, na.rm = na.rm)$output1
    if (is.null(dim(series))) {
        dim(series) <- c(time = length(series))
    } else {
      if (length(dim(series)) == 1) {
        if (!is.null(names(dim(series)))) {
          dim(series) <- c(1, dim(series))
          names(dim(series)) <- posdim
        } else {
          names(dim(series)) <- posdim
        }
      } else {  # more than one dim
        if (names(dim(series))[1] != "") {
          dim(series) <- c(1, dim(series))
          names(dim(series))[1] <- posdim
        } else {   #regular case
          names(dim(series))[1] <- posdim
        }
      }
    }

    if (any(dim_names != names(dim(series)))) {
        pos <- match(dim_names, names(dim(series)))
        series <- aperm(series, pos)
        names(dim(series)) <- dim_names
    }
    return(series)
}

.Season <- function(x, monini, moninf, monsup, operation = mean, na.rm = FALSE) {
    # Checks:
    if (!is.numeric(x)) {
        stop("Parameter 'x' must be a numeric vector.")
    }
    if (!is.numeric(monini)) {
        stop("Parameter 'monini' must be numeric.")
    } 
    if (length(monini) > 1) {
        monini <- monini[1] 
        warning("Parameter 'monini' has length > 1 and only the first ",
                "element will be used.")
    }
    if (monini %% 1 != 0) {
        stop("Parameter 'monini' must be an integer.")
    }
    if (!is.numeric(moninf)) {
        stop("Parameter 'moninf' must be numeric.")
    }
    if (length(moninf) > 1) {
        moninf <- moninf[1]
        warning("Parameter 'moninf' has length > 1 and only the first ",
                "element will be used.")
    }
    if (moninf %% 1 != 0) {
        stop("Parameter 'moninf' must be an integer.")
    }
    if (!is.numeric(monsup)) {
        stop("Parameter 'monsup' must be numeric.")
    }
    if (length(monsup) > 1) {
        monsup <- monsup[1]
        warning("Parameter 'monsup' has length > 1 and only the first ",
                "element will be used.")
    }
    if (monsup %% 1 != 0) {
        stop("Parameter 'monsup' must be an integer.")
    }
    # Check fun operation
    if (is.character(operation)) {
        fun_name <- operation
        err <- try({operation <- get(operation)}, silent = TRUE)
        if (!is.function(operation)) {
            stop("Could not find the function '", fun_name, "'.")
        }
     }
     if (!is.function(operation)) {
         stop("Parameter 'operation' must be a function or a character string ",
              "with the name of a function.")
     }

    # Correction need if monini is not January: 
    moninf <- moninf - monini + 1
    monsup <- monsup - monini + 1
    moninf <- ifelse(moninf <= 0, moninf + 12, moninf)
    monsup <- ifelse(monsup <= 0, monsup + 12, monsup)

    while (monsup < moninf) {
        monsup <- monsup + 12
    }

    #### Create position index:
    # Basic index:
    pos <- moninf : monsup
    # Extended index for all period:
    if (length(x) > pos[length(pos)]) {
        pos2 <- lapply(pos, function(y) {seq(y, length(x), 12)})
    } else {
        pos2 <- pos
    }
    # Correct if the final season is not complete:
    maxyear <- min(unlist(lapply(pos2, length)))
    pos2 <- lapply(pos2, function(y) {y[1 : maxyear]})
    # Convert to array:
    pos2 <- unlist(pos2)
    dim(pos2) <- c(year = maxyear, month = length(pos2)/maxyear)
    if (na.rm == TRUE) {
        if (length(which(is.na(x[pos2]))) > 0) {
             pos2 <- apply(pos2, 1, function(y){y[!is.na(x[y])]})
             timeseries <- unlist(lapply(pos2, function(y) {operation(x[y])}))
        } else {
             timeseries <- apply(pos2, 1, function(y) {operation(x[y])})
        }
    } else {
        timeseries <- apply(pos2, 1, function(y) {operation(x[y])})
    }
    return(timeseries)
}

