R/fastcluster.R

In fastcluster: Fast Hierarchical Clustering Routines for R and 'Python'

#  fastcluster: Fast hierarchical clustering routines for R and Python
#
#  Copyright:
#    * Until package version 1.1.23: © 2011 Daniel Müllner <http://danifold.net>
#    * All changes from version 1.1.24 on: © Google Inc. <http://google.com>

hclust <- function(d, method="complete", members=NULL)
{
  # Hierarchical clustering, on raw input data.
  if(method == "ward") {
    message("The \"ward\" method has been renamed to \"ward.D\"; note new \"ward.D2\"")
    method <- "ward.D"
  }
  # This array must agree with the enum method_codes in fastcluster.cpp.
  METHODS <- c("single", "complete", "average", "mcquitty", "ward.D", "centroid", "median", "ward.D2")
  method <- pmatch(method, METHODS)
  if (is.na(method))
    stop("Invalid clustering method.")
  if (method == -1)
    stop("Ambiguous clustering method.")
  dendrogram <- c( .Call(fastcluster, attr(d, "Size"), method, d, members),
    list(
      labels = attr(d, "Labels")
      ,method = METHODS[method]
      ,call = match.call()
      ,dist.method = attr(d, "method")
    )
  )
  class(dendrogram) <- "hclust"
  return (dendrogram)
}

hclust.vector <- function(X, method='single', members=NULL, metric='euclidean', p=NULL)
{
  # Hierarchical clustering, on vector data.
  METHODS <- c("single", "ward", "centroid", "median")
  methodidx <- pmatch(method, METHODS)
  if (is.na(methodidx))
    stop(paste("Invalid clustering method '", method, "' for vector data.", sep=''))
  if (methodidx == -1)
    stop("Ambiguous clustering method.")

  METRICS <- c("euclidean", "maximum", "manhattan", "canberra", "binary",
               "minkowski")
  metric = pmatch(metric, METRICS)
  if (is.na(metric) || metric > 6)
    stop("Invalid metric.")
  if (metric == -1)
    stop("Ambiguous metric.")
  if (metric == 4 && getRversion() < "3.5.0")
    metric <- as.integer(7) # special metric code for backwards compatibility

  if (methodidx!=1 && metric!=1)
    stop("The Euclidean methods 'ward', 'centroid' and 'median' require the 'euclidean' metric.")

  X <- as.matrix(X)

  dendrogram <- c( .Call(fastcluster_vector, methodidx, metric, X, members, p),
    list(
      labels = dimnames(X)[[1L]]
      ,method = METHODS[methodidx]
      ,call = match.call()
      ,dist.method = METRICS[metric]
    )
  )
  class(dendrogram) <- "hclust"
  return (dendrogram)
}