R/rclust.hclust.R

In kisungyou/RiemCluster: Cluster Analysis on Manifolds

#' Hierarchical Agglomerative Clustering
#' 
#' 
#' @examples 
#' ## load point clouds of 3 groups on sphere
#' data(sphere3)
#' \donttest{
#' ## visualize data on sphere
#' library("rgl")
#' mfrow3d(1,2)
#' spheres3d(0,0,0,lit=FALSE,color="white")
#' spheres3d(0,0,0,radius=1.01,lit=FALSE,color="black",front="lines")
#' spheres3d(sphere3[,1],sphere3[,2],sphere3[,3],col="black",radius=0.03)
#' }
#' 
#' ## wrap the data into 'riemdata' class 
#' ## note that when given as a matrix, each data be a column.
#' library(RiemBase)
#' rsp3 <- riemfactory(t(sphere3), name="Sphere")
#' 
#' ## apply hierarchical clustering with complete linkage
#' result  <- rclust.hclust(rsp3, method="complete")
#' 
#' ## get clustering labels under 3-group assumption
#' label3  <- stats::cutree(result, k=3)
#' 
#' \donttest{
#' ## find indices corresponding to 3 groups
#' idx.gp1 <- which(label3==unique(label3)[1])
#' idx.gp2 <- which(label3==unique(label3)[2])
#' idx.gp3 <- which(label3==unique(label3)[3])
#' 
#' ## visualize clustering results of 3 groups
#' rgl::next3d()
#' spheres3d(0,0,0,lit=FALSE,color="white")
#' spheres3d(0,0,0,radius=1.01,lit=FALSE,color="black",front="lines")
#' spheres3d(sphere3[idx.gp1,1],sphere3[idx.gp1,2],sphere3[idx.gp1,3],col="red",radius=0.03)
#' spheres3d(sphere3[idx.gp2,1],sphere3[idx.gp2,2],sphere3[idx.gp2,3],col="blue",radius=0.03)
#' spheres3d(sphere3[idx.gp3,1],sphere3[idx.gp3,2],sphere3[idx.gp3,3],col="yellow",radius=0.03)
#' 
#' ## you can close the RGL figure by 'rgl.close()'
#' }
#' 
#' @export
rclust.hclust <- function(input, type=c("extrinsic","intrinsic"),
                          method=c("single","complete","average","mcquitty",
                                   "ward.D","ward.D2","centroid","median"),
                          members=NULL){
  #-------------------------------------------------------
  if (is.matrix(input)){
    input = RiemBase::riemfactory(t(input), name="euclidean")
  }
  # must be of 'riemdata' class
  if ((class(input))!="riemdata"){
    stop("* rclust.hclust : the input must be of 'riemdata' class. Use 'riemfactory' first to manage your data.")
  }
  # acquire manifold name
  mfdname = tolower(input$name)
  # type and method checking checking
  mfdtype = match.arg(type)
  dmethod = match.arg(method)
  
  #-------------------------------------------------------
  # compute distance and apply 'fastcluster::hclust'
  dist   = stats::as.dist(rclust_pdist(input, type=mfdtype))
  output = fastcluster::hclust(dist, method=dmethod, members=members)
  return(output)
}