
.SelectDevice <- function(fileout) {
  # This function is used in the plot functions to check the extension of the 
  # files where the graphics will be stored and select the right R device to 
  # save them.
  # If the vector of filenames ('fileout') has files with different 
  # extensions, then it will only accept the first one, changing all the rest 
  # of the filenames to use that extension.

  # We extract the extension of the filenames: '.png', '.pdf', ...
  ext <- regmatches(fileout, regexpr("\\.[a-zA-Z0-9]*$", fileout))

  if (length(ext) != 0) {
    # If there is an extension specified, select the correct device
    if (ext[1] == ".png") {
      saveToFile <- png
    } else if (ext[1] == ".jpeg") {
        saveToFile <- jpeg
    } else if (ext[1] == ".eps") {
        saveToFile <- postscript
    } else if (ext[1] == ".ps") {
        saveToFile <- postscript
    } else if (ext[1] == ".pdf") {
        saveToFile <- pdf
    } else if (ext[1] == ".svg") {
        saveToFile <- svg
    } else if (ext[1] == ".bmp") {
        saveToFile <- bmp
    } else if (ext[1] == ".tiff") {
        saveToFile <- tiff
    } else {
      cat("! Warning: file extension not supported, it will be used '.eps' \n by default.\n")
      ## In case there is only one filename
      fileout[1] <- sub("\\.[a-zA-Z0-9]*$", ".eps", fileout[1])
      ext[1] <- ".eps"
      saveToFile <- postscript
    }
    # Change filenames when necessary
    if (any(ext != ext[1])) {
      cat(paste0("! Warning: some extensions of the filenames provided in 'fileout' are not ", ext[1],".\n The extensions are being converted to ", ext[1], ".\n"))
      fileout <- sub("\\.[a-zA-Z0-9]*$", ext[1], fileout)
    }
  } else {
    # Default filenames when there is no specification
    cat("! Warning: there are no extensions specified in the filenames, \n 
      default to '.eps'\n")
    fileout <- paste0(fileout, ".eps")
    saveToFile <- postscript
  }

  # return the correct function with the graphical device, and the correct 
  # filenames
  list(fun = saveToFile, files = fileout)
}


Loess <- function(clim,loess_span){
  data <- data.frame(ensmean=clim, day=1:length(clim))
  loess_filt <- loess(ensmean~day, data, span=loess_span)
  output <- predict(loess_filt)
  return(output)
}

AtomicWeatherRegime <- function(data, EOFS = TRUE, neofs = 30, threshold = NULL, lon = NULL, lat = NULL, ncenters = NULL, method = "kmeans",
                           nstart = 50, iter.max = 200) {
  
  names(dim(data)) <- c("sdate", "ftime", "lat", "lon")
  sdate <- which(names(dim(data)) == "sdate")
  ftime <- which(names(dim(data)) == "ftime")
  nftimes <- dim(data)[ftime]
  nsdates <- dim(data)[sdate]
  lon2 <- which(names(dim(data)) == "lon")
  lat2 <- which(names(dim(data)) == "lat")
  data <- aperm(data, c(ftime, sdate, lat2, lon2))
  nlon <- dim(data)[lon2]
  nlat <- dim(data)[lat2]
  dim(data) <- c(nftimes *  nsdates, nlat, nlon)
  
  if (is.null(ncenters)) {
    stop("ncenters must be specified")
  }
  if (EOFS  == TRUE && is.null(lon)) {
    stop("longitudes must be specified")
  }
  if (EOFS  == TRUE && is.null(lat)) {
    stop("latitudes must be specified")
  }
  
  if (EOFS  == TRUE) {
    #data <- princomp(data[,subs], cor = FALSE)$scores
    dataPC <- EOF(data, lat = as.vector(lat), lon = as.vector(lon), neofs = neofs)
    if (is.null(threshold)){
      threshold <- sum(dataPC$var)
      cluster_input <- dataPC$PC
    } else {
      threshold <- threshold
      minPC <- head(as.numeric(which(cumsum(dataPC$var) > threshold)), 1)
      cluster_input <- dataPC$PC[, 1 : minPC]    }
  } else {
    cluster_input <- data
    latWeights <- InsertDim(InsertDim(cos(lat*pi/180), 1, nftimes*nsdates), 3, nlon)
    cluster_input <- cluster_input * latWeights
    dim(cluster_input) <- c(nftimes * nsdates, nlat * nlon)
  } 
  if (method == "kmeans") {
    result <- kmeans(cluster_input, centers = ncenters, 
                     iter.max = iter.max, nstart = nstart, trace = FALSE)
    reconstructed <- array(0, c(ncenters, nlat, nlon))
    data <- aperm(data, c(2, 3, 1))
    reconstructed <- Composite(data, result$cluster)
    names(dim(reconstructed$composite)) <- c("lon", "lat", "cluster")
    cluster_timeseries <- list(lengths = c(), values = c())
    frequency <- persistence <- matrix(NA, nsdates, ncenters)
    for (i in 1 : nsdates) {
      occurences <- rle(result$cluster[((i * nftimes) + 1 - nftimes) : (i * nftimes)])
      cluster_timeseries <- list(lengths = c(cluster_timeseries$lengths, occurences$lengths),
                                 values = c(cluster_timeseries$values, occurences$values))
      for (j in 1 : ncenters) {
        frequency[i,j] <- (sum(occurences$lengths[occurences$values == j]) /  nftimes) * 100
        persistence[i,j] <- mean(occurences$lengths[occurences$values == j])
      }
    }
    # for (i in 1 : ncenters) {
    #   for (j in 1 : nsdates) {
    #     timeseries_subset <- cluster_timeseries$lengths#[(1 +((nftimes -1) * j)) : (nftimes * j)]
    #     cluster_subset <- cluster_timeseries$values[(1 +((nftimes -1) * j)) : (nftimes * j)]
    #     print(timeseries_subset)
    #     print(cluster_subset)
    #     print((1 +((nftimes -1) * j)) : (nftimes * j))
    #     stop()
    #     frequency[i, j] <- (sum(timeseries_subset[cluster_subset == i]) / length(nftimes)) * 100
    #     persistence[i,j] <- mean(timeseries_subset[cluster_subset == i])
    #   }
    #   #frequency[i] <- (sum(cluster_timeseries$lengths[cluster_timeseries$values == i]) / length(result$cluster)) * 100
    # }
  } else {
    result <- hclust(dist(cluster_input), method = method)
    clusterCut <- cutree(result, ncenters)
    data <- aperm(data, c(3, 2, 1))
    result <- Composite(data, clusterCut)
  }
  if (method == "kmeans") {
    return(list(composite = reconstructed$composite, pvalue = reconstructed$pvalue,  cluster = as.array(result$cluster), center = as.array(result$center),
                cluster_lengths = as.array(cluster_timeseries$lengths), cluster_values = as.array(cluster_timeseries$values),
                persistence = as.array(persistence), frequency = frequency))
  } else {
    return(list(composite = result$composite, pvalue = result$pvalue, cluster = as.array(clusterCut)))
  }
}

## if more then one member is specified (e.g: if you are using forecasts instead of reanalysis), it classifies each member separately
WeatherRegime <- function(data, EOFS = TRUE, neofs = 30, threshold = NULL, lon = NULL, lat = NULL, ncenters = NULL, method = "kmeans",
                          nstart = 50, iter.max = 200, ncores = 1) {
  if (length(dim(data)) > 4) {
    sdate <- which(names(dim(data)) == "sdate")
    ftime <- which(names(dim(data)) == "ftime")
    lon_dim <- which(names(dim(data)) == "lon")
    lat_dim <- which(names(dim(data)) == "lat")
    dims <- c(1 : length(dim(data)))[-c(sdate, ftime, lon_dim, lat_dim)] ## position of the member dimension
    data <- aperm(data, c(sdate, ftime, lat_dim, lon_dim, dims)) ## place the member dimension to the end of the array
    margins <- 5 : length(dim(data))
    result <- Apply(data = list(data), margins = list(margins), AtomicFun = "AtomicWeatherRegime", EOFS = EOFS, neofs = neofs, 
                    threshold = threshold, lon = lon, lat = lat, ncenters = ncenters, method = method, nstart = nstart, iter.max = iter.max, 
                    ncores = ncores)
  } else {
    result <- AtomicWeatherRegime(data, EOFS = EOFS, neofs = neofs, threshold = threshold,
                             lon = lon, lat = lat, ncenters = ncenters, method = method, nstart = nstart, iter.max= iter.max)
  }
  
}

anom2regime <- function(ref, target, method = 'distance', lat) {
  posdim <- which(names(dim(ref)) == 'nclust')
  poslat <- which(names(dim(ref)) == 'lat')
  poslon <- which(names(dim(ref)) == 'lon')
  
  nclust <- dim(ref)[posdim]
  
  if (all(dim(ref)[-posdim] != dim(target))) {
    stop('The target should have the same dimensions [lat,lon] that
         the reference ')
  }
  
  if (is.null(names(dim(ref))) | is.null(names(dim(target)))) {
    stop(
      'The arrays should include dimensions names ref[nclust,lat,lon]
      and target [lat,lon]'
    )
  }
  
  if (length(lat) != dim(ref)[poslat]) {
    stop('latitudes do not match with the maps')
  }
  
  # This dimensions are reorganized
  ref <- aperm(ref, c(posdim, poslat, poslon))
  target <-
    aperm(target, c(which(names(dim(
      target
    )) == 'lat'), which(names(dim(
      target
    )) == 'lon')))
  
  # weights are defined
  latWeights <- InsertDim(sqrt(cos(lat * pi / 180)), 2, dim(ref)[3])
  
  
  rmsdiff <- function(x, y) {
    dims <- dim(x)
    ndims <- length(dims)
    if (ndims != 2 | ndims != length(dim(y))) {
      stop('x and y should be maps')
    }
    map_diff <- NA * x
    for (i in 1:dims[1]) {
      for (j in 1:dims[2]) {
        map_diff[i, j] <- (x[i, j] - y[i, j]) ^ 2
      }
    }
    rmsdiff <- sqrt(mean(map_diff))
    return(rmsdiff)
  }
  
  if (method == 'ACC') {
    corr <- rep(NA, nclust)
    for (i in 1:nclust) {
      corr[i] <-
        ACC(InsertDim(InsertDim(
          InsertDim(ref[i, , ] * latWeights, 1, 1), 2, 1
        ), 3, 1),
        InsertDim(InsertDim(
          InsertDim(target * latWeights, 1, 1), 2, 1
        ), 3, 1))$ACC[2]
    }
    assign <- which(corr == max(corr))
  }
  
  if (method == 'distance') {
    rms <- rep(NA, nclust)
    for (i in 1:nclust) {
      rms[i] <- rmsdiff(ref[i, , ] * latWeights, target * latWeights)
    }
    assign <- which(rms == min(rms))
  }
  
  return(assign)
}

## modified to adapt for the new syntax of Apply() function as version 2.0.0 of multiApply package and added to Apply() option ncores=max(1, availableCores())
RegimesAssign <- function(var_ano, ref_maps, lats, method = 'distance') {
  posdim <- which(names(dim(ref_maps)) == 'nclust')
  poslat <- which(names(dim(ref_maps)) == 'lat')
  poslon <- which(names(dim(ref_maps)) == 'lon')
  poslat_ano <- which(names(dim(var_ano)) == 'lat')
  poslon_ano <- which(names(dim(var_ano)) == 'lon')
  
  nclust <- dim(ref_maps)[posdim]
  nlat <- dim(ref_maps)[poslat]
  nlon <- dim(ref_maps)[poslon]
    
  if (is.null(names(dim(ref_maps))) | is.null(names(dim(var_ano)))) {
    stop(
      'The arrays should include dimensions names ref[nclust,lat,lon]
      and target [lat,lon]'
    )
  }
  
  if (length(lats) != dim(ref_maps)[poslat]) {
    stop('latitudes do not match with the maps')
  }
  
  assign <-
    Apply(
      data = list(target = var_ano),
      margins = c((1:length(dim(
        var_ano
      )))[-c(poslat_ano, poslon_ano)]) ,
      fun = 'anom2regime',
      ref = ref_maps,
      lat = lats,
      method = method,
      ncores=max(1, availableCores())
    )
  
  anom_array <-
    array(var_ano, dim = c(prod(dim(var_ano)[-c(poslat_ano, poslon_ano)]), nlat, nlon))
  rm(var_ano)
  index <- as.vector(assign$output1)
  recon <- Composite(var = aperm(anom_array, c(3, 2, 1)), occ = index)
  freqs <- rep(NA, nclust)
  for (n in 1:nclust) {
    freqs[n] <- (length(which(index == n)) / length(index)) * 100
  }
  output <-
    list(
      composite = recon$composite,
      pvalue = recon$pvalue,
      cluster = assign$output1,
      frequency = freqs
    )
  return(output)
}

