#' @include utilities.R
NULL
#' Enhanced Distance Matrix Computation and Visualization
#' @description Clustering methods classify data samples into groups of similar 
#'   objects. This process requires some methods for measuring the distance or 
#'   the (dis)similarity between the observations. Read more: 
#'   \href{https://www.datanovia.com/en/lessons/clustering-distance-measures/}{STHDA
#'    website - clarifying distance measures.}. \itemize{ \item get_dist():
#'   Computes a distance matrix between the rows of a data matrix. Compared to
#'   the standard \code{\link[stats]{dist}}() function, it supports
#'   correlation-based distance measures including "pearson", "kendall" and
#'   "spearman" methods. \item fviz_dist(): Visualizes a distance matrix }
#'
#'   When \code{stand = TRUE}, scaling that produces non-finite values is
#'   rejected. \code{fviz_dist()} also validates that supplied distance objects
#'   contain only finite values before plotting.
#' @param x a numeric matrix or a data frame.
#' @param method the distance measure to be used. This must be one of 
#'   "euclidean", "maximum", "manhattan", "canberra", "binary", "minkowski", 
#'   "pearson", "spearman" or "kendall".
#' @param stand logical value; default is FALSE. If TRUE, then the data will be
#'   standardized using the function \code{scale()}. Measurements are
#'   standardized for each variable (column), by subtracting the variable's
#'   mean value and dividing by the variable's standard deviation. If scaling
#'   produces \code{NA} values, \code{get_dist()} stops with a package-level
#'   error.
#' @param ... other arguments to be passed to the function dist() when using get_dist().
#' @return \itemize{ \item get_dist(): returns an object of class "dist". \item 
#'   fviz_dist(): returns a ggplot2 }
#' @seealso \code{\link[stats]{dist}}
#' @author Alboukadel Kassambara \email{alboukadel.kassambara@@gmail.com}
#' @examples
#' data(USArrests)
#' res.dist <- get_dist(USArrests, stand = TRUE, method = "pearson")
#' 
#' fviz_dist(res.dist, 
#'    gradient = list(low = "#00AFBB", mid = "white", high = "#FC4E07"))
#' @name dist
#' @rdname dist
#' @export
get_dist <- function(x, method = "euclidean",  stand = FALSE, ...){
  
  if(stand) {
    x <- scale(x)
    if(anyNA(x))
      stop("Scaling produced NA values. Check for constant columns or non-finite values.")
  }
  if(method %in% c("pearson", "spearman", "kendall")){
    res.cor <- stats::cor(t(x),  method = method)
    res.dist <- stats::as.dist(1 - res.cor, ...)
  }
  else res.dist <- stats::dist(x, method = method, ...)
  
  res.dist
}

.check_dist_finite <- function(dist.obj){
  if(anyNA(dist.obj) || any(!is.finite(unclass(dist.obj))))
    stop("The distance matrix contains NA/NaN/Inf values. Check for constant columns or non-finite values.")
}


#' @param dist.obj an object of class "dist" as generated by the function
#'   \code{dist()} or \code{get_dist()}, containing only finite dissimilarity
#'   values.
#' @param order logical value. if TRUE the ordered dissimilarity image (ODI) is shown.
#' @param show_labels logical value. If TRUE, the labels are displayed.
#' @param lab_size the size of labels.
#' @param gradient a list containing three elements specifying the colors for low, mid and high values in 
#'  the ordered dissimilarity image. The element "mid" can take the value of NULL.
#' @rdname dist
#' @export
fviz_dist<- function(dist.obj, order = TRUE, show_labels = TRUE, lab_size = NULL,        
                     gradient = list(low = "red", mid = "white", high = "blue")
                     )
{
  
  if(!inherits(dist.obj, "dist"))
    stop("An object of class dist is required.")
  .check_dist_finite(dist.obj)
  
  if(order){
  res.hc <- stats::hclust(dist.obj, method = "ward.D2")
  dist.obj <- as.matrix(dist.obj)[res.hc$order, res.hc$order]
  }
  else dist.obj <- as.matrix(dist.obj)
  
  rownames(dist.obj ) <- colnames(dist.obj ) <- paste0(rownames(dist.obj), "-")

  # Convert distance matrix to long format (replacing reshape2::melt)
  # This creates a data frame with Var1, Var2, value columns
  d <- data.frame(
    Var1 = rep(rownames(dist.obj), ncol(dist.obj)),
    Var2 = rep(colnames(dist.obj), each = nrow(dist.obj)),
    value = as.vector(dist.obj)
  )
  # FIX: ggplot2 3.0.0+ deprecation - aes_string() replaced with aes() + .data pronoun
  # See: https://github.com/kassambara/factoextra/issues/190
  p <- ggplot(d, aes(x = .data[["Var1"]], y = .data[["Var2"]]))+
    ggplot2::geom_tile(aes(fill = .data[["value"]])) 
  if(is.null(gradient$mid)) p <- p + ggplot2::scale_fill_gradient(low=gradient$low, high=gradient$high)
  else p <- p + ggplot2::scale_fill_gradient2(midpoint=mean(dist.obj), low=gradient$low, 
                                                    mid=gradient$mid, high=gradient$high, space = "Lab")
  if(show_labels) p <- p + theme(axis.title.x = element_blank(), 
                                       axis.title.y = element_blank(),
                                       axis.text.x = element_text(angle = 45, hjust = 1, size = lab_size),
                                       axis.text.y = element_text(size = lab_size))
  else p <- p + 
    theme(axis.text = element_blank(), axis.ticks = element_blank(),
          axis.title.x = element_blank(),
          axis.title.y = element_blank())
  
  return(p)
}
