#'Computes The Regression Of An Array On Another Along A Dimension
#'
#'Computes the regression of the input matrice vary on the input matrice varx 
#'along the posREG dimension by least square fitting. Provides the slope of 
#'the regression, the associated confidence interval, and the intercept.\cr
#'Provides also the vary data filtered out from the regression onto varx.\cr
#'The confidence interval relies on a student-T distribution.
#'
#'@param vary Array of any number of named dimensions.
#'@param varx Array of any number of named dimensions. 
#'The same dimensions as vary are expected.
#'@param posREG The name of the dimension along which to compute the regression.
#'@param na.action a logical value indicating whether NA values should be stripped before the computation proceeds or a numeric value indicating the maximum number of NA values allowed to compute the regression.
#'@param formula an object of class "formula" (see function \code{link[stats]{lm}}).
#'
#'@import multiApply
#'@return 
#'  \item{$regression}{
#'    Array with same dimensions as varx and vary except along posREG 
#'    dimension which is replaced by a length 4 dimension, corresponding 
#'    to the lower limit of the 95\% confidence interval, the slope, 
#'    the upper limit of the 95\% confidence interval and the intercept.
#'  }
#'  \item{$filtered}{
#'    Same dimensions as vary filtered out from the regression onto varx 
#'    along the posREG dimension.
#'  }
#'
#'@keywords datagen
#'@author History:\cr
#'0.1  -  2013-05  (V. Guemas, \email{virginie.guemas@ic3.cat})  -  Original code\cr
#'1.0  -  2013-09  (N. Manubens, \email{nicolau.manubens@ic3.cat})  -  Formatting to CRAN
#'2.0  -  2019-10  (N. Perez-Zanon, \email{nuria.perez@bsc.es})  -  Formatting to multiApply
#'@examples
#'vary <- 1:(2*3*4*5*6)
#'dim(vary) <- c(lat = 2, lon = 3, member = 4, time = 6, sdate = 5)
#'varx <- vary
#'res <- Regression(vary, varx, posREG = 'time')
#'str(res)
#'varx[c(1,5,7,9:22)] <- NA
#'res <- Regression(vary, varx, posREG = 'time', na.action = 2)
#'length(which(is.na(res$filtered)))
#'res <- Regression(vary, varx, posREG = 'time', na.action = 0)
#'length(which(is.na(res$filtered)))
#'vary[1] <- NA
#'res <- Regression(vary, varx, posREG = 'time')
#'res <- Regression(vary, varx, posREG = 'time', na.action = 5)
#'exp <- 1 : 70
#'obs <- rnorm(70)
#'dim(exp) <- c(time = 70)
#'dim(obs) <- c(time = 70)
#'reg <- Regression(exp, obs, posREG = 'time')
#'reg <- Regression(exp, obs, posREG = 'time', na.action = 10)
#'
#'@importFrom stats lm na.omit confint
#'
#'@export
Regression <- function(vary, varx, posREG = 'member', na.action = na.omit, formula = y ~ x) {
    if (is.vector(vary)) {
        dim(vary) <- c(length(vary)) 
        if (is.character(posREG)) {
            names(dim(vary)) <- posREG
        } else {
            if (is.vector(varx)) {
                posREG <- 'Dim1'
            } else if (length(dim(varx)) == 1) {
                posREG <- names(dim(varx))
            } else {
                stop("Parameter 'vary' and 'varx' must be arrays with named",
                     " dimensions.")
            }
            names(dim(vary)) <- posREG
        }
    }
    if (is.vector(varx)) {
        if (dim(vary)[posREG] == length(varx)) {
            if (length(dim(vary)) == 1) {
                dim(varx) <- c(length(varx))
                names(varx) <- posREG
            } else {
                varx <- rep(varx, prod(dim(vary)[-posREG]))
                dim(varx) <- dim(vary)
            }
        }
    }
    #compare dimensions 
    dimsy <- dim(vary)
    dimsx <- dim(varx)
    if (length(dimsy) != length(dimsx)) {
        stop("Parameter 'vary' and 'varx' must have the same ",
             "dimensions.")
    }
    if (is.null(names(dimsy)) & is.null(names(dimsx))) {
        names(dim(vary)) <- paste0("Dim", 1 : length(dimsy)) 
        names(dim(vary)) <- paste0("Dim", 1 : length(dimsy))
        if (is.character(posREG)) {
            stop("Parameters 'vary' and 'varx' must have dimension names.")
        }
    }
 
  adjusted <- Apply(list(vary, varx), target_dims = posREG, fun = .Regression,
                    na.action = na.action, formula = formula, 
                    output_dims = list(regression = 'coeff', filtered = posREG))
  invisible(list(regression = adjusted$regression, filtered = adjusted$filtered))
}
.Regression <- function(y, x, na.action = na.omit, formula = y ~ x) {
    if (!is.numeric(x) | !is.numeric(y)) {
        stop("Parameter 'x' and 'y' must be numeric.")
    }
    if (!is.function(na.action) &  !is.numeric(na.action)) {
       warning("Parameter 'na.action' must be a function for dealing ",
               "with NA values (e.g.: na.omit, na.exclude, na.fail, na.pass)",
               " or a numeric value indicating the number of NA values ",
               "allowed before returning an NA.")
    }
    if (is.numeric(na.action)) {
        NApos <- 1 : length(x)
        NApos[which(is.na(x))] <- NA
        NApos[which(is.na(y))] <- NA
        if (sum(is.na(NApos)) > na.action) {
            filter <- rep(NA, length(x)) 
            regress <- rep(NA, 4)
        } else {
            adj <- lm(formula, data = data.frame(x = x, y = y), na.action = na.omit)
            filter <- NApos
            filter[!is.na(filter)] <- adj$fitted.values
            regress <- c(confint(adj)[2, 1], adj$coefficients[2],
                         confint(adj)[2, 2], adj$coefficients[1])           
            }
    } else {
        NApos <- 1 : length(x)
        NApos[which(is.na(x))] <- NA
        NApos[which(is.na(y))] <- NA
        adj <- lm(formula, data = data.frame(x = x, y = y), na.action = na.action)
        filter <- NApos
        filter[!is.na(filter)] <- adj$fitted.values
        regress <- c(confint(adj)[2, 1], adj$coefficients[2],
                     confint(adj)[2, 2], adj$coefficients[1])
    }     

   return(list(regression = regress, filtered = filter))
}
