#'Project anomalies onto modes of variability
#'
#'Project anomalies onto modes of variability to get the temporal evolution of 
#'the EOF mode selected. It returns principal components (PCs) by area-weighted
#'projection onto EOF pattern (from \code{EOF()}) or REOF pattern (from 
#'\code{REOF()} or \code{EuroAtlanticTC()}). The calculation removes NA and 
#'returns NA if the whole spatial pattern is NA.
#'
#'@param ano A numerical array of anomalies with named dimensions. The 
#'  dimensions must have at least 'time_dim' and 'space_dim'. It can be
#'  generated by Ano().
#'@param eof A list that contains at least 'EOFs' or 'REOFs' and 'wght', which 
#'  are both arrays. 'EOFs' or 'REOFs' must have dimensions 'mode' and 
#'  'space_dim' at least. 'wght' has dimensions space_dim. It can be generated 
#'  by EOF() or REOF().
#'@param time_dim A character string indicating the name of the time dimension
#' of 'ano'. The default value is 'sdate'. 
#'@param space_dim A vector of two character strings. The first is the dimension
#'  name of latitude of 'ano' and the second is the dimension name of longitude
#'  of 'ano'. The default value is c('lat', 'lon').
#'@param mode An integer of the variability mode number in the EOF to be 
#'  projected on. The default value is NULL, which means all the modes of 'eof'
#'  is calculated.
#'@param ncores An integer indicating the number of cores to use for parallel 
#'  computation. The default value is NULL.
#'
#'@return A numerical array of the principal components in the verification 
#'  format. The dimensions are the same as 'ano' except 'space_dim'.
#'
#'@seealso EOF, NAO, PlotBoxWhisker
#'
#'@examples
#' startDates <- c('19851101', '19901101', '19951101', '20001101', '20051101')
#' sampleData <- LoadSampleData(startDates,
#'                              leadtimemin = 1,
#'                              leadtimemax = 4,
#'                              output = 'lonlat')
#' ano <- Ano_CrossValid(sampleData$mod, sampleData$obs)
#' eof_exp <- EOF(ano$exp, sampleData$lat, sampleData$lon, neofs = 5) 
#' eof_obs <- EOF(ano$obs, sampleData$lat, sampleData$lon, neofs = 5) 
#' mode1_exp <- ProjectField(ano$exp, eof_exp, mode = 1)
#' mode1_obs <- ProjectField(ano$obs, eof_obs, mode = 1)
#' 
#' \donttest{
#'   # Plot the forecast and the observation of the first mode for the last year 
#'   # of forecast
#'   sdate_dim_length <- dim(mode1_obs)['sdate']
#'   plot(mode1_obs[sdate_dim_length, 1, 1, ], type = "l", ylim = c(-1, 1), 
#'        lwd = 2)
#'   for (i in 1:dim(mode1_exp)['member']) {
#'     par(new = TRUE)
#'     plot(mode1_exp[sdate_dim_length, 1, i, ], type = "l", col = rainbow(10)[i], 
#'          ylim = c(-15000, 15000))
#'   }
#' }
#'
#'@import multiApply
#'@export
ProjectField <- function(ano, eof, time_dim = 'sdate', space_dim = c('lat', 'lon'), 
                         mode = NULL, ncores = NULL) {

  # Check inputs 
  ## ano (1)
  if (is.null(ano)) {
    stop("Parameter 'ano' cannot be NULL.")
  }
  if (!is.numeric(ano)) {
    stop("Parameter 'ano' must be a numeric array.")
  }
  if (any(is.null(names(dim(ano)))) | any(nchar(names(dim(ano))) == 0)) {
    stop("Parameter 'ano' must have dimension names.")
  }
  ## eof (1)
  if (is.null(eof)) {
    stop("Parameter 'eof' cannot be NULL.")
  }
  if (!is.list(eof)) {
    stop("Parameter 'eof' must be a list generated by EOF() or REOF().")
  }
  if ('EOFs' %in% names(eof)) {
    EOFs <- "EOFs"
  } else if ('REOFs' %in% names(eof)) {
    EOFs <- "REOFs"
  } else if ('patterns' %in% names(eof)) {
    EOFs <- "patterns"
  } else {
    stop("Parameter 'eof' must be a list that contains 'EOFs', 'REOFs', ",
         "or 'patterns'. It can be generated by EOF(), REOF(), or EuroAtlanticTC().")
  } 
  if (!'wght' %in% names(eof)) {
    stop("Parameter 'eof' must be a list that contains 'wght'. ",
         "It can be generated by EOF() or REOF().")
  }
  if (!is.numeric(eof[[EOFs]]) || !is.array(eof[[EOFs]])) {
    stop("The component 'EOFs' or 'REOFs' of parameter 'eof' must be a numeric array.")
  }
  if (!is.numeric(eof$wght) || !is.array(eof$wght)) {
    stop("The component 'wght' of parameter 'eof' must be a numeric array.")
  }
  ## 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(ano))) {
    stop("Parameter 'time_dim' is not found in 'ano' dimension.")
  }
  ## space_dim
  if (!is.character(space_dim) | length(space_dim) != 2) {
    stop("Parameter 'space_dim' must be a character vector of 2.")
  }
  if (!all(space_dim %in% names(dim(ano)))) {
    stop("Parameter 'space_dim' is not found in 'ano' dimension.")
  }
  ## ano (2)
  if (!all(space_dim %in% names(dim(ano))) | !time_dim %in% names(dim(ano))) {
    stop("Parameter 'ano' must be an array with dimensions named as ",
         "parameter 'space_dim' and 'time_dim'.")
  }
  ## eof (2)
  if (!all(space_dim %in% names(dim(eof[[EOFs]]))) | 
      !'mode' %in% names(dim(eof[[EOFs]]))) {
    stop("The component 'EOFs' or 'REOFs' of parameter 'eof' must be an array ",
         "with dimensions named as parameter 'space_dim' and 'mode'.")
  }
  if (length(dim(eof$wght)) != 2 | !all(names(dim(eof$wght)) %in% space_dim)) {
    stop("The component 'wght' of parameter 'eof' must be an array ",
         "with dimensions named as parameter 'space_dim'.")
  }
  ## mode
  if (!is.null(mode)) {
    if (!is.numeric(mode) | mode %% 1 != 0 | mode < 0 | length(mode) > 1) {
      stop("Parameter 'mode' must be NULL or a positive integer.")
    }
    if (mode > dim(eof[[EOFs]])['mode']) {
      stop("Parameter 'mode' is greater than the number of available ",
           "modes in 'eof'.")
    }
  }
  ## 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.")
    }
  }
 
#-------------------------------------------------------

  # Keep the chosen mode
  if (!is.null(mode)) {
    eof_mode <- ClimProjDiags::Subset(eof[[EOFs]], 'mode', mode, drop = 'selected')
  } else {
    eof_mode <- eof[[EOFs]]
  }

  if ('mode' %in% names(dim(eof_mode))) {
    dimnames_without_mode <- names(dim(eof_mode))[-which(names(dim(eof_mode)) == 'mode')]
  } else {
    dimnames_without_mode <- names(dim(eof_mode))
  }

  if (all(dimnames_without_mode %in% space_dim)) { # eof_mode: [lat, lon] or [mode, lat, lon]
    if ('mode' %in% names(dim(eof_mode))) {
      eof_mode_target <- c('mode', space_dim)
      output_dims <- c('mode', time_dim)
    } else {
      eof_mode_target <- space_dim
      output_dims <- time_dim
    }
    res <- Apply(list(ano, eof_mode),
                 target_dims = list(c(time_dim, space_dim),
                                    eof_mode_target),
                 output_dims = output_dims,
                 wght = eof$wght,
                 fun = .ProjectField,
                 ncores = ncores)$output1

  } else {

    if (!all(dimnames_without_mode %in% names(dim(ano)))) {
      stop("The array 'EOF' in parameter 'eof' has dimension not in parameter ",
           "'ano'. Check if 'ano' and 'eof' are compatible.")
    }
  
    common_dim_ano <- dim(ano)[which(names(dim(ano)) %in% dimnames_without_mode)]
    if (any(common_dim_ano[match(dimnames_without_mode, names(common_dim_ano))] != 
        dim(eof_mode)[dimnames_without_mode])) {
      stop("Found paramter 'ano' and 'EOF' in parameter 'eof' have common dimensions ",
           "with different length. Check if 'ano' and 'eof' are compatible.")
    }
  
    # Enlarge eof/ano is needed. The margin_dims of Apply() must be consistent
    # between ano and eof.
    additional_dims <- dim(ano)[-which(names(dim(ano)) %in% names(dim(eof_mode)))]
    additional_dims <- additional_dims[-which(names(additional_dims) == time_dim)]
    if (length(additional_dims) != 0) {
      for (i in seq_along(additional_dims)) {
        eof_mode <- InsertDim(eof_mode, posdim = (length(dim(eof_mode)) + 1), 
                              lendim = additional_dims[i], name = names(additional_dims)[i])
      }
    }
    if ('mode' %in% names(dim(eof_mode))) {
      eof_mode_target <- c('mode', space_dim)
      output_dims <- c('mode', time_dim)
    } else {
      eof_mode_target <- space_dim
      output_dims <- time_dim
    }
    res <- Apply(list(ano, eof_mode),
                 target_dims = list(c(time_dim, space_dim),
                                    eof_mode_target),
                 output_dims = output_dims,
                 wght = eof$wght,
                 fun = .ProjectField,
                 ncores = ncores)$output1
  }

  return(res)
}


.ProjectField <- function(ano, eof_mode, wght) {
  # ano: [sdate, lat, lon]
  # eof_mode: [lat, lon] or [mode, lat, lon]
  # wght: [lat, lon]

  ntime <- dim(ano)[1]
  if (length(dim(eof_mode)) == 2) {  # mode != NULL
    # Initialization of pc.ver.
    pc.ver <- array(NA, dim = ntime)  #[sdate]
  
    # Weight
    e.1 <- eof_mode * wght
    ano <- ano * InsertDim(wght, 1, ntime)
    #ano <- aaply(ano, 1, '*', wght)  # much heavier

    na <- rowMeans(ano, na.rm = TRUE) # if [lat, lon] all NA, it's NA
    #na <- apply(ano, 1, mean, na.rm = TRUE)  # much heavier
    tmp <- ano * InsertDim(e.1, 1, ntime)  # [sdate, lat, lon]
    rm(ano)
    #pc.ver <- apply(tmp, 1, sum, na.rm = TRUE)  # much heavier 
    pc.ver <- rowSums(tmp, na.rm = TRUE)
    pc.ver[which(is.na(na))] <- NA

  } else {  # mode = NULL
    # Weight
    e.1 <- eof_mode * InsertDim(wght, 1, dim(eof_mode)[1])
    dim(e.1) <- c(dim(eof_mode)[1], prod(dim(eof_mode)[2:3]))  # [mode, lat*lon] 
    ano <- ano * InsertDim(wght, 1, ntime)
    dim(ano) <- c(ntime, prod(dim(ano)[2:3]))  # [sdate, lat*lon]

    na <- rowMeans(ano, na.rm = TRUE) # if [lat, lon] all NA, it's NA
    na <- aperm(array(na, dim = c(ntime, dim(e.1)[1])), c(2, 1))

    # Matrix multiplication e.1 [mode, lat*lon] by ano [lat*lon, sdate]
    # Result: [mode, sdate]
    pc.ver <- e.1 %*% t(ano)  
    pc.ver[which(is.na(na))] <- NA

#  # Change back dimensions to feet original input
#  dim(projection) <- c(moredims, mode = unname(neofs))
#  return(projection)
  }

  return(pc.ver)
}

