WeatherRegime <- function(data, EOFS = TRUE, neofs = 30, threshold = 90, lat_weights = TRUE, lon = NULL, lat = NULL, ncenters = NULL, method = "kmeans",
                         nstart = 30, iter.max = 100, listindex = NULL, ncores = NULL) {
  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)]
    data <- aperm(data, c(sdate, ftime, lat_dim, lon_dim, dims))
    margins <- 5 : length(dim(data))
    result <- Apply(data = list(data), margins = list(margins), AtomicFun = ".WeatherRegime", EOFS = EOFS, neofs = neofs, 
                    threshold = threshold, lat_weights = lat_weights, lon = lon, lat = lat, ncenters = ncenters, method = method, 
                    ncores = ncores)
  } else {
    result <- .WeatherRegime(data, EOFS = EOFS, neofs = neofs, threshold = threshold, lat_weights = lat_weights,
                             lon = lon, lat = lat, ncenters = ncenters, method = method)
  }
 
}

.WeatherRegime <- function(data, EOFS = TRUE, neofs = 30, threshold = 90, lat_weights = lat_weights, lon = NULL, lat = NULL, ncenters = NULL, method = "kmeans",
                          nstart = 30, listindex = NULL) {
  
  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("nclusters must be specified")
  }
  if (EOFS  == TRUE) {
    if (lat_weights == FALSE) {
      stop("If 'EOFS = TRUE', then latitude weightings are calculated automatically")
    }
    #data <- princomp(data[,subs], cor = FALSE)$scores
    dataPC <- EOF(data, lat = lat, lon = lon, neofs = neofs)
    threshold <- threshold
    minPC <- head(as.numeric(which(cumsum(dataPC$var) > threshold)), 1)
    cluster_input <- dataPC$PC[, 1 : minPC]
  } else {
    cluster_input <- data
    if (lat_weights == TRUE) {
      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 = 100, 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())
    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))
    }
    frequency <- persistence <- c()
    for (i in 1 : ncenters) {
      frequency[i] <- (sum(cluster_timeseries$lengths[cluster_timeseries$values == i]) / length(result$cluster)) * 100
      persistence[i] <- mean(cluster_timeseries$length[cluster_timeseries$values == i])
    }
    
  } 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 = as.array(frequency)))
  } else {
    return(list(composite = result$composite, pvalue = result$pvalue, cluster = as.array(clusterCut)))
  }
}


