#' @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 data 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 clustering_on Decides whether to calculate the scenarios among members with same sdate ('member') or among different sdates ('sdate') but fixed member.
#' @return A list with elements \code{$labels} (cluster assigned for each member),
#'         \code{$freq} (relative frequency of each cluster), \code{$closest_member}
#'         (representative member for each cluster), \code{$clus_repr_field} (list of fields
#'         for each representative member), \code{clus_composites} (list of mean fields for each cluster).
#' @export
#' @examples
#' \donttest{
#' exp <- 1 : (2 * 3 * 4 * 8 * 8)
#' }

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

  result <- EnsClus(datalist$exp$data, datalist$exp$lat, datalist$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,
                    clustering_on = clustering_on)

  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 exp_time A matrix of dimensions 'dataset member sdate ftime lat lon' containing the variables to be analysed. If dataset is a s2dv_cube, exp_time = dataset$exp$data
#' @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 clustering_on Decides whether to calculate the scenarios among members with same sdate ('member') or among different sdates ('sdate') but fixed member.
#' @return A list with elements \code{$labels} (cluster assigned for each member),
#'         \code{$freq} (relative frequency of each cluster), \code{$closest_member}
#'         (representative member for each cluster), \code{$clus_repr_field} (list of fields
#'         for each representative member), \code{clus_composites} (list of mean fields for each cluster).
#' @export
#' @examples
#' \donttest{
#' exp <- 1 : (2 * 3 * 4 * 8 * 8)
#' }

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

  print(dim(exp_time))

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

  if (time_moment == "sd") {
    print("Considering the time_moment: sd")
    exp <- apply(exp_time, c(1, 2, 3, 5, 6), sd)
  }

  if (time_moment == "perc") {
    print(paste0("Considering the time_moment: percentile ",
                 sprintf("%5f", time_percentile)))
    exp <- apply(exp_time, c(1, 2, 3, 5, 6), quantile, time_percentile / 100.)
  }

  print(dim(exp))
  # dataset  member   sdate   ftime     lat     lon
  # Repeatedly apply .ensclus
  # It would be better to apply on the named dimensions here..
  if (clustering_on == "sdate") {
    result <- apply(exp, c(1, 2), .ensclus, lat, lon, numclus = numclus,
                    lon_lim = lon_lim, lat_lim = lat_lim,
                    varfrac_explained = varfrac_explained, numpcs = numpcs,
                    flag_varfrac = flag_varfrac)
} else if (clustering_on == "member") {
    result <- apply(exp, c(1, 3), .ensclus, lat, lon, numclus = numclus,
                    lon_lim = lon_lim, lat_lim = lat_lim,
                    varfrac_explained = varfrac_explained,
                    numpcs = numpcs, flag_varfrac = flag_varfrac)
 }
  return(result)
}

# 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) {
  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]

  print("Calculating ensemble anomalies...")
  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)

  clus_labels <- as.array(clusters$cluster)
  frequencies <- as.array(clusters$frequencies)

  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, ])
      print(paste0("distance from cluster ", iclu, " center:"))
      print(this_clus_labels)
      print(dist_arr)
      closest_member[iclu] <- this_clus_labels[which.min(dist_arr)]
      dist_closest_member[iclu] <- min(dist_arr)
      print(paste0("closest member to cluster ", iclu, " center is: ",
                   closest_member[iclu]))
    } else {
      print(paste0("distance from cluster ", iclu, " center:"))
      dista <- .dist_from_center(clusters$pcs[clus_labels == iclu, ],
                                center = clus_centers[iclu, ])
      print(this_clus_labels)
      print(dista)
      closest_member[iclu] <- this_clus_labels
      dist_closest_member[iclu] <- dista
    }
  }
  print("EnsClus completed...")
  out <- list(labels = clus_labels, freq = frequencies,
              closest_member = closest_member,
              clus_repr_field = var_ens[closest_member, , ],
              clus_composites = clusters$regimes)
  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...", 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) {
  # 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
  print("Launching EOFs...")
  t0 <- proc.time()
  if (flag_varfrac) {
    if (is.null(perc)) {
      print("flag_varfrac is TRUE but no perc as been specified")
    }
    reducedspace <- .eofs(lon, lat, field, neof = max_eofs, xlim = xlim,
                          ylim = ylim, method = "SVD", do_regression = F,
                          do_standardize = F)
    neof <- which(cumsum(reducedspace$variance) > perc / 100.)[1]
    print(paste("Number of EOFs needed for var:", neof))
    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)
    # extract the principal components
    PC <- reducedspace$coeff
  }
  t1 <- proc.time() - t0

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

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

  print("Creating Composites...")
  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
  print("Finalize...")
  out <- list(cluster = cluster, frequencies = frequencies[kk],
              regimes = compose[kk, , ], pcs = PC,
              clus_centers = regimes$centers[kk, ],
              tot.withinss = regimes$tot.withinss)
  return(out)
}


# new function to create simple list with date values - Oct-18
# it needs a date or PCICt object, and returns also the season subdivision
.power.date <- function(datas, verbose = FALSE) {

  # create a "season" for continuous time, used by persistance tracking
  startpoints <- c(0, which(diff(datas) > 1))
  deltapoints <- diff(c(startpoints, length(datas)))
  seas <- inverse.rle(list(lengths = deltapoints,
                           values = seq(1, length(startpoints))))

  etime <- list(
    day = as.numeric(format(datas, "%d")),
    month = as.numeric(format(datas, "%m")),
    year = as.numeric(format(datas, "%Y")), data = datas, season = seas
  )

  .printv("Time Array Built", verbose)
  .printv(paste("Length:", length(seas)), verbose)
  .printv(paste("From", datas[1], "to", datas[length(seas)]), verbose)
  return(etime)
}

# function for daily anomalies, use array predeclaration
#  and rowMeans (40 times faster!)
.daily.anom.mean <- function(ics, ipsilon, field, etime) {
  condition <- paste(etime$day, etime$month)
  daily <- array(NA, dim = c(length(ics), length(ipsilon),
                             length(unique(condition))))
  anom <- field * NA

  for (t in unique(condition)) {
    if (sum(t == condition) == 1) {
      print(paste0("Cannot compute a mean with only one value: ",
                   "using climatological mean"))
      anom[, , which(t == condition)] <- rowMeans(field, dims = 2)
    } else {
      daily[, , which(t == unique(condition))] <-
        rowMeans(field[, , t == condition], dims = 2)
      anom[, , which(t == condition)] <-
        sweep(field[, , which(t == condition)], c(1, 2),
              daily[, , which(t == unique(condition))], "-")
    }
  }
  return(anom)
}

# 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)
}
