R/visCPS.R

In OTclust: Mean Partition, Uncertainty Assessment, Cluster Validation and Visualization Selection for Cluster Analysis

#' CPS Analysis on selecting visualization method.
#'
#' Covering Point Set Analysis on the visualization results. Use K-Nearest Neighbor to generate a collection of results for CPS Analysis. The return contains several statistics which can be directly used as input for mplot or cplot.
#' @param vlab -- the coordinates generated by one visualization method in a numeric matrix of two columns.
#' @param ref -- the true labels in a vector format, the first cluster is labeled as 1.
#' @param nEXP -- number of perturbed results for CPS Analysis.
#' @return a list used for mplot or cplot, in which tight_all is the overall tightness, member is the matrix used for the membership heat map, set is the matrix for the covering point set plot, tight is the vector of cluster-wise tightness, vis is the visualization coordinates, ref is the reference labels and topo is the topological relationship between clusters for point-wise uncertainty assessment.
#' @examples
#' # CPS analysis on selection of visualization methods
#' data(vis_pollen)
#' c=visCPS(vis_pollen$vis, vis_pollen$ref)
#' # visualization of the results
#' mplot(c,2)
#' cplot(c,2)
#' @export
visCPS <- function(vlab, ref, nEXP=100){
  if(ncol(vlab)!=2) stop('Please provide valid visulization coordinates!\n')
  if(min(ref)<1) stop('the first cluster must be labeled as 1\n')
  re=matrix(0,ncol=nEXP,nrow=nrow(vlab))
  for(i in 1:nEXP){
    ## Adding noise
    inp=as.matrix(vlab[,c(1,2)])
    toy=apply(inp,2,addnoise,nrow=nrow(inp),sd=sqrt(0.01*mean(apply(inp,2,var))))
    ## Nearest Neighbour on perturbed coordinates
    tar=as.matrix(vlab[,c(1,2)])
    c=class::knn(tar,toy,ref,k=1)
    re[,i]=matrix(c,ncol=1)
  }
  ## CPS Analysis
  k=max(ref)
  save=rbind(matrix(as.integer(ref)-1,ncol=1),matrix(as.integer(re)-1,ncol=1))
  cps=ACPS(save,nEXP+1,1)
  pen=cps$match[,1]/apply(cps$match,1,sum)
  tit=cps$statistics[,4]*pen
  tit=matrix(tit,nrow=1)
  rownames(tit)=c("Tightness of each cluster")
  colnames(tit)=seq(1,k,1)
  ## output
  tight_all=mean(tit)
  member=cps$id
  set=t(cps$cps)
  tight=tit
  v=vlab
  topo=cps$topo_result
  out=list(tight_all=tight_all, member=member, set=set, tight=tight, vis=v, ref=ref, topo=topo, numcls=cps$numcls, nEXP=nEXP, save=save, weight=cps$weight)
}