#'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()}). 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' and 'wght', which are both 
#'  arrays. 'EOFs' must have dimensions 'mode' and 'space_dim' at least.
#'  'wght' has dimensions space_dim. It can be generated by EOF().
#'@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 1.
#'@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
#'\dontshow{
#'startDates <- c('19851101', '19901101', '19951101', '20001101', '20051101')
#'sampleData <- s2dv:::.LoadSampleData('tos', c('experiment'),
#'                                     c('observation'), startDates,
#'                                     leadtimemin = 1,
#'                                     leadtimemax = 4,
#'                                     output = 'lonlat',
#'                                     latmin = 27, latmax = 48,
#'                                     lonmin = -12, lonmax = 40)
#'}
#'ano <- Ano_CrossValid(sampleData$mod, sampleData$obs)
#'eof_exp <- EOF(ano$exp, sampleData$lat, sampleData$lon) 
#'eof_obs <- EOF(ano$obs, sampleData$lat, sampleData$lon) 
#'mode1_exp <- ProjectField(ano$exp, eof_exp)
#'mode1_obs <- ProjectField(ano$obs, eof_obs)
#'
#'\dontrun{
#'  # 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))
#'  }
#'}
#'
#'@export
ProjectField <- function(ano, eof, time_dim = 'sdate', space_dim = c('lat', 'lon'), 
                         mode = 1, 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().")
  }
  if (!all(c('EOFs', 'wght') %in% names(eof))) {
    stop("Parameter 'eof' must contain 'EOFs' and 'wght' generated by EOF().")
  }
  if (!is.numeric(eof$EOFs) || !is.array(eof$EOFs)) {
    stop("The component 'EOFs' 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 (any(!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(paste0("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(paste0("The component 'EOFs' 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(paste0("The component 'wght' of parameter 'eof' must be an array ",
                "with dimensions named as parameter 'space_dim'."))
  }
  ## mode
  if (!is.numeric(mode) | mode %% 1 != 0 | mode < 0 | length(mode) > 1) {
    stop("Parameter 'mode' must be a positive integer.")
  }
  if (mode > dim(eof$EOFs)['mode']) {
    stop(paste0("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
  eof_mode <- Subset(eof$EOFs, 'mode', mode, drop = 'selected')

  if (all(names(dim(eof_mode)) %in% space_dim)) { # eof_mode: [lat, lon]

    res <- Apply(list(ano),
                 target_dims = list(c(space_dim, time_dim)),
                 output_dims = time_dim,
                 eof_mode = eof_mode,
                 wght = eof$wght,
                 fun = .ProjectField,
                 ncores = ncores)$output1

  } else {
    if (!all(names(dim(eof_mode)) %in% names(dim(ano)))) {
      stop(paste0("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% names(dim(eof_mode)))]
    if (any(sort(common_dim_ano) != sort(dim(eof_mode)))) {
      stop(paste0("Found paramter 'ano' and 'EOF' in parameter 'eof' have different ",
                  "common dimensions. 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 1:length(additional_dims)) {
        eof_mode <- InsertDim(eof_mode, posdim = (length(dim(eof_mode)) + 1), 
                              lendim = additional_dims[i], name = names(additional_dims)[i])
      }
    }

    res <- Apply(list(ano, eof_mode),
                 target_dims = list(c(space_dim, time_dim),
                                    c(space_dim)),
                 output_dims = time_dim,
                 wght = eof$wght,
                 fun = .ProjectField,
                 ncores = ncores)$output1
  }

  return(res)
}


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

  dim_time <- dim(ano)[3]

  # Initialization of pc.ver.
  pc.ver <- array(NA, dim = dim_time)  #[sdate]
  
  # Weigths
  e.1 <- eof_mode * wght
  ano <- ano * InsertDim(wght, 3, dim_time)

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

  return(pc.ver)
}

