#'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 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.
#'
#'@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)
#'@export
Season <- function(var, posdim = 'time', monini, moninf, monsup, 
                   operation = mean) {
    # 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(time = length(var))
    }
    if (length(dim(var)) == 1 && is.null(names(dim(var)))) {
        names(dim(var)) <- 'time'
        time_dim <- 1
    } else {
        if (is.null(names(dim(var)))) {
            stop("Parameter 'var' must contain dimesnion names.")
        }
        if (is.numeric(posdim)) {
            time_dim <- posdim 
            posdim <- names(dim(var))[posdim]
        }
        if (is.character(posdim)) {
            time_dim <- which(names(dim(var)) == posdim)
        }
    }
    dim_names <- names(dim(var))
#    series <- apply(var, margins, .Season, 
#                    monini = monini, moninf = moninf, monsup = monsup,
#                    fun = fun)
    series <- Apply(list(var), 
                    target_dims = posdim, 
                    # margins = margins,
                    fun = .Season, 
                    monini = monini, moninf = moninf, monsup = monsup,
                    operation = operation)$output1
                    #, output_dims = 'time')$output1
    if (length(dim_names) > 1) {
        if (length(dim(series)) == length(dim_names)) {
            names(dim(series))[1] <- posdim
            # print("FLAG1")
        } else {
            dim_names <- dim_names[-time_dim]
            # print("FLAG2")
        }
        pos <- match(dim_names, names(dim(series)))
        series <- aperm(series, pos)
        names(dim(series)) <- dim_names
    } else {
        dim(series) <- c(time = length(series))
    }
    return(series)
}

.Season <- function(x, monini, moninf, monsup, operation = mean) {
    # 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 e.g. 'winter':
    #while (monsup < moninf) {
    #    monsup <- monsup + 12
    #}
    # Correction need if monini is not January: 
    moninf <- moninf + monini - 1
    monsup <- monsup + monini - 1
    
    # Correction e.g. 'winter':
    while (monsup < moninf) {
        monsup <- monsup + 12
    }

    #### Create position index:
    # Basic index:
    pos <- moninf : monsup
    # Extended index for all period:
    pos2 <- lapply(pos, function(y) {seq(y, length(x), 12)})
    # 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)
    
    timeseries <- apply(pos2, 1, function(y) {operation(x[y])})
    return(timeseries)
}

