#Define a function that receives 3 multidimensional arrays:
#     - dat1: One with the dimensions 'time', 'lat' and 'lon'.
#     - dat2: One with the dimensions 'lat' and 'lon'.
#     - dat3: One with the dimensions 'time' and 'lat'.
#Plus the following additional parameters:
#     - a Boolean parameter called revert_order
#     - the '...' parameter

#The function should:
#    a) take the second array and subtract it to each time step in the first array.
#    b) for each time step in the first array, all values along the 'lon' dimension for each 'lat' should be multiplied by the corresponding value in the third array.
#    c) for each time step, the area average is computed (using the mean() function, to which the additional parameters in '...' are forwarded).
#    d) if revert_order == TRUE, b) should be performed before a).

#The function should return an array with the dimension 'time'.

#-------
#dat1 <- 1 : 100
#dim(dat1) <- c(time = 10, lat = 5, lon = 2)
#
#dat2 <- rep(1:5, 2)
#dim(dat2) <- c(lat = 5, lon = 2)
#
#dat3 <- rep(1:5, each = 10)
#dim(dat3) <- c(time = 10, lat = 5)
#
#weighted <- c(1, 0.8, 0.6, 0.4, 0.2)
#
#--------
library(plyr)

func_apply2 <- function(dat1, dat2, dat3, revert_order = FALSE, weighted = NULL, ...) {
  # Check dat1
  if (!is.numeric(dat1) || !is.array(dat1)) {
    stop("Parameter 'dat1' must be a numeric array.")
  }
  input_error <- FALSE
  if (length(dim(dat1)) != 3) {
    input_error <- TRUE
  }
  if (input_error) {
    stop("Parameter 'dat1' must be numeric and have three dimension, ",
         "following order: 'time', 'lat', 'lon'.")
  }

  # Check dat2
  if (!is.numeric(dat2) || !is.array(dat2)) {
    stop("Parameter 'dat2' must be a numeric array.")
  }
  input_error <- FALSE
  if (length(dim(dat2)) != 2) {
    input_error <- TRUE
  }
 if (input_error) {
    stop("Parameter 'dat2' must be numeric and have two dimensions, ",
         "following order: 'lat', 'lon'.")
  }

  # Check dat3
  if (!is.numeric(dat3) || !is.array(dat3)) {
    stop("Parameter 'dat3' must be a numeric array.")
  }
  input_error <- FALSE
  if (length(dim(dat3)) != 2) {
    input_error <- TRUE
  }
  if (input_error) {
    stop("Parameter 'dat3' must be numeric and have two dimensions, ",
         "following order: 'time', 'lat'.")
  }

# Consistency checks dat1, dat2, dat3
  time_dim_len <- dim(dat1)[1]
  lat_dim_len <- dim(dat1)[2]
  lon_dim_len <- dim(dat1)[3]
  if (dim(dat1)[1] != time_dim_len || dim(dat3)[1] != time_dim_len) {
    stop("Found an inconsistency in the length of the dimension 'time' in ",
         "parameters 'dat1' and 'dat3'.")
  }
  if (dim(dat1)[2] != lat_dim_len || dim(dat2)[1] != lat_dim_len ||
      dim(dat3)[2] != lat_dim_len) {
    stop("Found an inconsistency in the length of the dimension 'lat' in ",
         "parameters 'dat1', 'dat2' and 'dat3'.")
  }
  if ((dim(dat1)[3] != lon_dim_len) || (dim(dat2)[2] != lon_dim_len)) {
    stop("Found an inconsistency in the length of the dimension 'lon' in ",
         "parameters 'dat1' and 'dat2'.")
  }

  # Check revert_order
  if (!is.logical(revert_order)) {
    stop("Parameter 'revert_order' must be a logical value.")
  }
  if (length(revert_order) != 1) {
    stop("Parameter 'revert_order' must be of length 1.")
  }


  dim1 <- dim(dat1)
  dim2 <- dim(dat2)
  dim3 <- dim(dat3)

if(revert_order == FALSE) {

#a)
#  num1_time <- which(names(dim(dat1)) == 'time')
  dat2_rep <- array(dat2, dim = c(dim2[1], dim2[2], dim1[1]))
  num1 <- which(dim(dat2_rep) == dim(dat1)[1])
  num2 <- which(dim(dat2_rep) == dim(dat1)[2])
  num3 <- which(dim(dat2_rep) == dim(dat1)[3])
  dat2_rep <- s2dverification:::.aperm2(dat2_rep, c(num1, num2, num3))

  res1 <- dat1 - dat2_rep

#b)
#  num1_lon <- which(names(dim(res1)) == 'lon')
  tmp <- rep(dat3, dim1[3])
  dat3_rep <- array(tmp, dim = c(dim3[1], dim3[2], dim1[3]))
  num1 <- which(names(dim(dat3_rep)) == names(dim(res1))[1])
  num2 <- which(names(dim(dat3_rep)) == names(dim(res1))[2])
  num3 <- which(names(dim(dat3_rep)) == names(dim(res1))[3])
  dat3_rep <- s2dverification:::.aperm2(dat3_rep, c(num1, num2, num3))

  res2 <- res1 * dat3_rep
} 

if(revert_order == TRUE) {

#b)
#  num1_lon <- which(names(dim(dat1)) == 'lon')
  tmp <- rep(dat3, dim1[3])
  dat3_rep <- array(tmp, dim = c(dim3[1], dim3[2], dim1[3]))
  num1 <- which(names(dim(dat3_rep)) == names(dim(dat1))[1])
  num2 <- which(names(dim(dat3_rep)) == names(dim(dat1))[2])
  num3 <- which(names(dim(dat3_rep)) == names(dim(dat1))[3])
  dat3_rep <- s2dverification:::.aperm2(dat3_rep, c(num1, num2, num3))

  res1 <- dat1 * dat3_rep

#a)
#  num1_time <- which(names(dim(res1)) == 'time')
  tmp <- rep(dat2, dim1[1])
  dat2_rep <- array(tmp, dim = c(dim2[1], dim2[2], dim1[1]))
  num1 <- which(names(dim(dat2_rep)) == names(dim(res1))[1])
  num2 <- which(names(dim(dat2_rep)) == names(dim(res1))[2])
  num3 <- which(names(dim(dat2_rep)) == names(dim(res1))[3])
  dat2_rep <- s2dverification:::.aperm2(dat2_rep, c(num1, num2, num3))
#  names(dim(dat2_rep)) <- c(names(dim(res1))[1], names(dim(res1))[2], names(dim(res1))[3])

  res2 <- res1 - dat2_rep

}

#c)
  #weighted? need lat/weighted as an input

  fun_wt <- function(x, ...) {
    weighted.mean(x, weighted)
  }

  f1 <- function(res2, weighted, ...) {
    if(is.null(weighted)) {
      result <- apply(res2, 1, mean, ...)
    } else {
      tmp <- aaply(res2, 1, 2, mean, ...)
      result <- apply(tmp, 1, FUN = fun_wt) 
    }
    return(result)
  }
   
  res3 <- f1(res2, weighted = weighted, ...)  
  dim(res3) <- c(time = length(res3))
  return(res3)

}
