source("...../PCA.R")
library(s2dverification)
library(multiApply)

# example of executing PCA
data <- 1 : (2 * 3 * 5)
dim(data) <- c(time = 5, lat = 3, lon = 2)

lon <- c(0, 5)
lat <- c(40, 45, 50)
time <- seq(as.Date("1993-01-01", format = "%Y-%m-%d"), as.Date("1997-01-01", format = "%Y-%m-%d"), "year")
weights <- rep(1, length(lat))
weights <- matrix(1, nrow = length(lat), ncol = length(lon))

PCA(anomVar = data, lon = lon, lat = lat, wght = weights, neofs = 2)

# comparison of prcomp with or without Apply
  mat <- c(rep(1, 10), c(rep(1, 5), rep(100, 5)))
  dim(mat) <- c(time = 10, grid = 2)

  res <- prcomp(mat)
  out <- Apply(data = mat, target_dims = c('time', 'grid'), fun = prcomp)

# Checking differences of dimensions
  mat <- 1 : (2 * 5)
  dim(mat) <- c(observation = 5, grid = 2)
  res <- prcomp(mat)
  out1 <- Apply(data = mat, target_dims = c('time', 'grid'), fun = prcomp)
  Narray <- 1 : (2 * 3 * 5)
  dim(Narray) <- c(observation = 5, grid = 2, extra = 3)
  out2 <- Apply(data = Narray, target_dims = c('time', 'grid'), fun = prcomp)
  res$sdev
  out1$sdev
  out2$sdev
  dim(out1$sdev)
  dim(out2$sdev)
  res$roation
  out1$rotation
  out2$rotation
  dim(out1$rotation)
  dim(out2$rotation)
  
  Narray <- 1 : (2 * 3 * 4 * 5)
  dim(Narray) <- c(time = 2, lat = 3, lon =4, obs = 5)  
  dimnames <- names(array)  
  dim(Narray)['lat']
  dim(Narray)[which(names(dim(Narray)) == 'lat')]
  
  
# ----- The PCA function I'm using:  
PCA <- function (anomVar, lon, lat, neofs = 15, wght, normVariance=FALSE, 
                 projwanom=FALSE) {
  if (!is.numeric(anomVar) || !is.array(anomVar)) {
    stop("Parameter 'anomVar' must be a numeric array.")
  }
  if (length(dim(anomVar)) != 3) {
    stop("'anomVar' must have dimensions c(n. start dates/forecast time 
         steps/time samples, n. latitudes, n. longitudes).")
  }
  if (!is.numeric(lon) || !is.numeric(lat)) {
    stop("'lon' and 'lat' must be numeric vectors.")
  }
  if (any(lon > 360 | lon < -360)) {
    .warning("some 'lon's out of the range [-360, 360].")
  }
  if (any(lat > 90 | lat < -90)) {
    stop("'lat' must contain values within the range [-90, 90].")
  }
  if (!is.numeric(neofs)) {
    stop("'neofs' must be numeric.")
  }
  neofs <- round(neofs)
  nlon <- length(lon)
  nlat <- length(lat)
  dim.dat <- dim(anomVar)
  ny <- dim.dat[2]
  nx <- dim.dat[3]
  nt <- dim.dat[1]
  if (ny != nlat) {
    stop("Inconsistent number of latitudes and input field dimensions.")
  }
  if (nx != nlon) {
    stop("Inconsistent number of longitudes and input field dimensions.")
  }
  mask <- anomVar[1, , ]
  mask[!is.finite(mask)] <- NA
  mask[is.finite(mask)] <- 1
  anomVar[!is.finite(anomVar)] <- 0
  wAnomVar <- anomVar * InsertDim(wght, 1, nt)
  dim(wAnomVar) <- c(nt, ny * nx)
  neofs <- min(dim(wAnomVar), neofs)
  prcomp.wAnomVar <- prcomp(wAnomVar, center=FALSE, scale.=FALSE) 
  aEOFs <- t(prcomp.wAnomVar$rotation[,1:neofs])
  if (normVariance){
    aEOFs <- array(dim=c(neofs,ny*nx))
    for (iPC in 1:neofs){
      aEOFs[iPC,] <- prcomp.wAnomVar$rotation[,iPC]/(prcomp.wAnomVar$sdev)[iPC]
    }
  }
  dim(anomVar) <- c(nt, ny * nx)
  if(!projwanom){
    # Coordinates are calculated projecting the anomalies not weigthed
    aPCs <- NULL
    aPCs <- array(dim=c(nt,neofs))
    for (iEOF in 1:neofs){
      for (itime in 1:nt){
        aPCs[itime,iEOF] <- anomVar[itime,]%*% t(aEOFs)[,iEOF] 
        # coordinates for each EOF (projecting unweighted anomalies over each component)
      }  
    }
  }else{
    aPCs <- prcomp.wAnomVar$x[,1:neofs] # coordinates for each EOF 
    # (projecting weighted anomalies over each component)
    if (neofs == 1) {
      aPCs <- InsertDim(aPCs, 2, 1)
    }
  }
  dim(aEOFs) <- c(neofs,ny,nx)
  W <- prcomp.wAnomVar$sdev[1:neofs] 
  tot.var <- sum(prcomp.wAnomVar$sdev^2)
  var.eof <- 100 * prcomp.wAnomVar$sdev[1:neofs]^2/tot.var
  return(list(EOFs=aEOFs, PCs=aPCs, var = var.eof, mask = mask, 
              wght = wght, lat=lat, lon=lon))
  
  }
