#' @rdname CST_EnsClus
#' @title Ensemble clustering
#'
#' @author Federico Fabiano - ISAC-CNR, \email{f.fabiano@isac.cnr.it}
#' @author Ignazio Giuntoli - ISAC-CNR, \email{i.giuntoli@isac.cnr.it}
#' @author Danila Volpi - ISAC-CNR, \email{d.volpi@isac.cnr.it}
#' @author Paolo Davini - ISAC-CNR, \email{p.davini@isac.cnr.it}
#' @author Jost von Hardenberg - ISAC-CNR, \email{j.vonhardenberg@isac.cnr.it}
#'
#' @description This function performs a clustering on members/starting dates and returns a number of scenarios, with representative members for each of them. The clustering is performed in a reduced EOF space.
#'
#' @param exp An object of the class 's2dv_cube', containing the variables to be analysed.
#' Each data object in the list is expected to have an element named \code{$data} with at least two
#' spatial dimensions named "lon" and "lat", a dimension "ftime" and a dimension "sdate".
#' @param time_moment Decides the moment to be applied to the time dimension. Can be either 'mean' (time mean), 'sd' (standard deviation along time) or 'perc' (a selected percentile on time). If 'perc' the keyword 'time_percentile' is also needed.
#' @param time_percentile Set the percentile in time you want to analyse. Active only if time_moment is 'perc'.
#' @param numclus Number of clusters (scenarios) to be calculated.
#' @param lon_lim List with the two longitude margins. (-180,180) format.
#' @param lat_lim List with the two latitude margins.
#' @param varfrac_explained Variance to be explained by the set of eofs. Used only if flag_varfrac is True.
#' @param numpcs Number of eofs retained in the analysis.
#' @param flag_varfrac Selects the minimum number of eofs needed to reach the varfrac_explained.
#' @param cluster_dim Decides whether to calculate the scenarios among members with same sdate ('member') or among different sdates ('sdate') but fixed member.
#' @param Logical for verbose output
#' @return A list with elements \code{$cluster} (cluster assigned for each member),
#'         \code{$freq} (relative frequency of each cluster), \code{$closest_member}
#'         (representative member for each cluster), \code{$repr_field} (list of fields
#'         for each representative member), \code{composites} (list of mean fields for each cluster).
#' @export
#' @examples
#' \donttest{
#' exp <- 1 : (2 * 3 * 4 * 8 * 8)
#' }

CST_EnsClus <- function(exp, time_moment = "mean", numclus = 4,
                        lon_lim = NULL, lat_lim = NULL,
                        varfrac_explained = 80, numpcs = 4,
                        flag_varfrac = FALSE, time_percentile = NULL,
                        cluster_dim = "member", verbose = F) {
  if (!inherits(exp, "s2dv_cube")) {
    stop("Parameter 'exp' must be of the class 's2dv_cube', ",
         "as output by CSTools::CST_Load.")
  }

  result <- EnsClus(exp$data, exp$lat, exp$lon,
                    time_moment = time_moment, numclus = numclus,
                    lon_lim = lon_lim, lat_lim = lat_lim,
                    varfrac_explained = varfrac_explained, numpcs = numpcs,
                    flag_varfrac = flag_varfrac,
                    time_percentile = time_percentile,
                    cluster_dim = cluster_dim, verbose = verbose)

  return(result)
}

#' @rdname EnsClus
#' @title Ensemble clustering
#'
#' @author Federico Fabiano - ISAC-CNR, \email{f.fabiano@isac.cnr.it}
#' @author Ignazio Giuntoli - ISAC-CNR, \email{i.giuntoli@isac.cnr.it}
#' @author Danila Volpi - ISAC-CNR, \email{d.volpi@isac.cnr.it}
#' @author Paolo Davini - ISAC-CNR, \email{p.davini@isac.cnr.it}
#' @author Jost von Hardenberg - ISAC-CNR, \email{j.vonhardenberg@isac.cnr.it}
#'
#' @description This function performs a clustering on members/starting dates and returns a number of scenarios, with representative members for each of them. The clustering is performed in a reduced EOF space.
#'
#' @param data A matrix of dimensions 'dataset member sdate ftime lat lon' containing the variables to be analysed.
#' @param time_moment Decides the moment to be applied to the time dimension. Can be either 'mean' (time mean), 'sd' (standard deviation along time) or 'perc' (a selected percentile on time). If 'perc' the keyword 'time_percentile' is also needed.
#' @param time_percentile Set the percentile in time you want to analyse. Active only if time_moment is 'perc'.
#' @param numclus Number of clusters (scenarios) to be calculated.
#' @param lon_lim List with the two longitude margins. (-180,180) format.
#' @param lat_lim List with the two latitude margins.
#' @param varfrac_explained Variance to be explained by the set of eofs. Used only if flag_varfrac is True.
#' @param numpcs Number of eofs retained in the analysis.
#' @param flag_varfrac Selects the minimum number of eofs needed to reach the varfrac_explained.
#' @param cluster_dim Decides whether to calculate the scenarios among members with same sdate ('member') or among different sdates ('sdate') but fixed member.
#' @param verbose Logical for verbose output
#' @return A list with elements \code{$cluster} (cluster assigned for each member),
#'         \code{$freq} (relative frequency of each cluster), \code{$closest_member}
#'         (representative member for each cluster), \code{$repr_field} (list of fields
#'         for each representative member), \code{composites} (list of mean fields for each cluster).
#' @export
#' @examples
#' \donttest{
#' exp <- 1 : (2 * 3 * 4 * 8 * 8)
#' }

EnsClus <- function(data, lat, lon, time_moment = "mean", numclus = 4,
                    lon_lim = NULL, lat_lim = NULL, varfrac_explained = 80,
                    numpcs = 4, flag_varfrac = FALSE, time_percentile = NULL,
                    cluster_dim = "member", verbose = T) {

  # Apply time_moment
  if (time_moment == "mean") {
    .printv("Considering the time_moment: mean", verbose)
    exp <- apply(data, c(1, 2, 3, 5, 6), mean)
  }

  if (time_moment == "sd") {
    .printv("Considering the time_moment: sd", verbose)
    exp <- apply(data, c(1, 2, 3, 5, 6), sd)
  }

  if (time_moment == "perc") {
    .printv(paste0("Considering the time_moment: percentile ",
                 sprintf("%5f", time_percentile)), verbose)
    exp <- apply(data, c(1, 2, 3, 5, 6), quantile, time_percentile / 100.)
  }
 
  # Repeatedly apply .ensclus
  result <- Apply(exp, target_dims = c(cluster_dim, "lat", "lon"), .ensclus,
                  lat, lon, numclus = numclus,
                  lon_lim = lon_lim, lat_lim = lat_lim,
                  varfrac_explained = varfrac_explained,
                  numpcs = numpcs, flag_varfrac = flag_varfrac,
                  verbose = verbose)
  return(append(result, list(lat = lat, lon = lon)))
}

# Atomic ensclus function
.ensclus <- function(var_ens, lat, lon, numclus = 4, lon_lim = NULL,
                     lat_lim = NULL, varfrac_explained = 80, numpcs = 4,
                     flag_varfrac = FALSE, verbose = T) {
  if (length(lat) != dim(var_ens)[2]) {
    print("Incorrect lat length")
    exit()
  }
   
  if (length(lon) != dim(var_ens)[3]) {
    print("Incorrect lon length")
    exit()
  }
  n_ens <- dim(var_ens)[1]

  .printv("Calculating ensemble anomalies...", verbose)
  ens_mean <- apply(var_ens, c(2, 3), mean)
  var_anom <- array(dim = dim(var_ens))
  for (k in seq(1, n_ens)) {
    var_anom[k, , ] <- var_ens[k, , ] - ens_mean
  }

  # reshaping to give the right input to regimes function
  var_anom <- aperm(var_anom, c(3, 2, 1))
  clusters <- .regimes(lon, lat, var_anom, ncluster = numclus, ntime = 1000,
                      neof = numpcs, lon_lim, lat_lim,
                      flag_varfrac = flag_varfrac, perc = varfrac_explained,
                      max_eofs = n_ens - 1, verbose = verbose)

  clus_labels <- as.array(clusters$cluster)
  names(dim(clus_labels))[1] <- names(dim(var_ens))[1]
  frequencies <- as.array(clusters$frequencies)
  names(dim(frequencies))[1] <- "cluster"

  clus_centers <- clusters$clus_centers

  closest_member <- array(dim = numclus)
  dist_closest_member <- array(dim = numclus)
  for (iclu in seq(1, numclus)) {
    this_clus_labels <- which(clus_labels == iclu)
    if (length(this_clus_labels) > 1) {
      dist_arr <- apply(clusters$pcs[clus_labels == iclu, ], 1,
                        .dist_from_center, center = clus_centers[iclu, ])
      .printv(paste0("distance from cluster ", iclu, " center:"), verbose)
      .printv(this_clus_labels, verbose)
      .printv(dist_arr, verbose)
      closest_member[iclu] <- this_clus_labels[which.min(dist_arr)]
      dist_closest_member[iclu] <- min(dist_arr)
      .printv(paste0("closest member to cluster ", iclu, " center is: ",
                   closest_member[iclu]), verbose)
    } else {
      .printv(paste0("distance from cluster ", iclu, " center:"), verbose)
      dista <- .dist_from_center(clusters$pcs[clus_labels == iclu, ],
                                center = clus_centers[iclu, ])
      .printv(this_clus_labels, verbose)
      .printv(dist_arr, verbose)
      closest_member[iclu] <- this_clus_labels
      dist_closest_member[iclu] <- dista
    }
  }
  .printv("EnsClus completed...", verbose)

  names(dim(closest_member))[1] <- "cluster"
  repr_field <- var_ens[closest_member, , ]
  names(dim(repr_field))[2:3] <- names(dim(var_ens))[2:3]
  names(dim(repr_field))[1] <- "cluster"
  # Bring back to original order lat lon
  composites <- aperm(clusters$regimes, c(1, 3, 2))
  names(dim(composites))[2:3] <- names(dim(var_ens))[2:3]
  names(dim(composites))[1] <- "cluster"
  out <- list(cluster = clus_labels, freq = frequencies,
              closest_member = closest_member, repr_field = repr_field,
              composites = composites)
  return(out)
}

.dist_from_center <- function(y, center = NULL) {
  dist <- sqrt(sum((y - center)^2))
  return(dist)
}

.eofs <- function(lon, lat, field, neof = 4, xlim = NULL, ylim = NULL,
                  method = "SVD", do_standardize = F, do_regression = F,
                  verbose = T) {
  # R tool for computing EOFs based on
  # Singular Value Decomposition ("SVD", default)
  # or with the eigenvectors of the covariance matrix ("covariance", slower)
  # If requested, computes linear regressions and standardizes the PCs
  # If you want to use the regressions, remember to standardize the PCs
  # Take as input a 3D anomaly field.
  # Requires "personal" functions area.weight, whicher and standardize

  # area weighting, based on the root of cosine
  .printv("Area Weighting...", verbose)
  ww <- .area.weight(lon, lat, root = T)
  wwfield <- sweep(field, c(1, 2), ww, "*")

  # selection of the xbox and ybox if defined
  if (!is.null(xlim)) {
    lonselect <- .whicher(lon, xlim[1]):.whicher(lon, xlim[2])
  } else {
    lonselect <- 1:length(lon)
  }

  if (!is.null(ylim)) {
    latselect <- .whicher(lat, ylim[1]):.whicher(lat, ylim[2])
  } else {
    latselect <- 1:length(lat)
  }

  # box
  box <- wwfield[lonselect, latselect, ]
  slon <- lon[lonselect]
  slat <- lat[latselect]

  # transform 3D field in a matrix
  new_box <- array(box, dim = c(dim(box)[1] * dim(box)[2], dim(box)[3]))

  # calling SVD
  if (method == "SVD") {
    .printv("Calling SVD...", verbose)
    SVD <- svd(new_box, nu = neof, nv = neof)

    # extracting EOFs (loading pattern), expansions coefficient
    # and variance explained
    pattern <- array(SVD$u, dim = c(dim(box)[1], dim(box)[2], neof))
    coefficient <- SVD$v
    variance <- (SVD$d[1:neof])^2 / sum((SVD$d)^2)
    if (do_standardize) {
      coefficient <- apply(coefficient, c(2), standardize)
    } else {
      coefficient <- sweep(coefficient, c(2), sqrt(variance), "*")
    }
  }

  # calling covariance matrix
  if (method == "covariance") {
    .printv("Calling eigenvectors of the covariance matrix...", verbose)
    covma <- cov(t(new_box))
    eig <- eigen(covma)
    coef <- (t(new_box) %*% eig$vector)[, 1:neof]
    pattern <- array(eig$vectors, dim = c(dim(box)[1], dim(box)[2],
                                          dim(box)[3]))[, , 1:neof]
    variance <- eig$values[1:neof] / sum(eig$values)
    if (do_standardize) {
      coefficient <- apply(coef, c(2), standardize)
    } else {
      coefficient <- coef
    }
  }

  # linear regressions on anomalies
  regression <- NULL
  if (do_regression) {
    .printv("Linear Regressions (it can takes a while)... ", verbose)
    regression <- array(NA, dim = c(length(lon), length(lat), neof))
    for (i in 1:neof) {
      regression[, , i] <- apply(field, c(1, 2),
         function(x) lin.fit(as.matrix(coefficient[, i],
                                       ncol = 1), x)$coefficients)
    }
  }

  # preparing output
  .printv("Finalize eofs...", verbose)
  pattern <- list(x = slon, y = slat, z = pattern)
  out <- list(pattern = pattern, coeff = coefficient, variance = variance,
              regression = regression)
  return(out)
}


.regimes <- function(lon, lat, field, ncluster = 4, ntime = 1000, neof = 10,
                     xlim, ylim, alg = "Hartigan-Wong", flag_varfrac = FALSE,
                     perc = NULL, max_eofs = 50, verbose = T) {
  # R tool to compute cluster analysis based on k-means.
  # Requires "personal" function eofs
  # Take as input a 3D anomaly field

  # Reduce the phase space with EOFs: use SVD and do not standardize PCs
  .printv("Launching EOFs...", verbose)
  t0 <- proc.time()
  if (flag_varfrac) {
    if (is.null(perc)) {
      print("Warning: flag_varfrac is TRUE but no perc as been specified")
      stop()
    }
    reducedspace <- .eofs(lon, lat, field, neof = max_eofs, xlim = xlim,
                          ylim = ylim, method = "SVD", do_regression = F,
                          do_standardize = F, verbose = verbose)
    neof <- which(cumsum(reducedspace$variance) > perc / 100.)[1]
    .printv(paste("Number of EOFs needed for var:", neof), verbose)
    PC <- reducedspace$coeff[,1:neof]
  } else {
    reducedspace <- .eofs(lon, lat, field, neof = neof, xlim = xlim,
                          ylim = ylim, method = "SVD", do_regression = F,
                          do_standardize = F, verbose = verbose)
    # extract the principal components
    PC <- reducedspace$coeff
  }
  t1 <- proc.time() - t0

  # k-means computation repeat for ntime to find best solution.
  .printv("Computing k-means...", verbose)
  t0 <- proc.time()
  regimes <- kmeans(PC, as.numeric(ncluster), nstart = ntime,
                    iter.max = 1000, algorithm = alg)
  t1 <- proc.time() - t0

  # Extract regimes frequency and timeseries of occupation
  cluster <- regimes$cluster
  frequencies <- regimes$size / dim(field)[3] * 100
  .printv("Cluster frequencies:", verbose)
  .printv(frequencies[order(frequencies, decreasing = T)], verbose)

  .printv("Creating Composites...", verbose)
  compose <- apply(field, c(1, 2), by, cluster, mean)

  # sorting from the more frequent to the less frequent
  kk <- order(frequencies, decreasing = T)
  cluster <- cluster + 100
  for (ss in 1:ncluster) {
    cluster[cluster == (ss + 100)] <- which(kk == ss)
  }

  # prepare output
  .printv("Finalize regimes...", verbose)
  out <- list(cluster = cluster, frequencies = frequencies[kk],
              regimes = compose[kk, , ], pcs = PC,
              clus_centers = regimes$centers[kk, ],
              tot.withinss = regimes$tot.withinss)
  return(out)
}

# produce a 2d matrix of area weights
.area.weight <- function(ics, ipsilon, root = T) {
  field <- array(NA, dim = c(length(ics), length(ipsilon)))
  if (root == T) {
    for (j in 1:length(ipsilon)) {
      field[, j] <- sqrt(cos(pi / 180 * ipsilon[j]))
    }
  }

  if (root == F) {
    for (j in 1:length(ipsilon)) {
      field[, j] <- cos(pi / 180 * ipsilon[j])
    }
  }

  return(field)
}

# verbose-only printing function
.printv <- function(value, verbosity = TRUE) {
  if (verbosity) {
    print(value)
  }
}

# detect ics ipsilon lat-lon
.whicher <- function(axis, number) {
  out <- which.min(abs(axis - number))
  return(out)
}

# normalize a time series
.standardize <- function(timeseries) {
  out <- (timeseries - mean(timeseries, na.rm = T)) /
         sd(timeseries, na.rm = T)
  return(out)
}
