R/plot.credpart.R

In evclust: Evidential Clustering

#' Plotting a credal partition
#'
#' Generates plots of a credal partition.
#'
#' This function plots different views of a credal partition in a two-dimensional attribute space. 
#' If mfrow=c(1,1) (the default), the function plot the dataset with a different symbol for each cluster.
#'
#' @param x An object of class \code{"credpart"}, encoding a credal partition.
#' @param X A data matrix. If it has more than two columns (attributes), only the first two
#' columns are used.
#' @param ... Other arguments to be passed to the plot function.
#' @param mfrow A 2-vector defining the number of rows and columns of the plot. If mfrow=c(1,1),
#' only one figure is drawn. Otherwise, mfrow[1] x mfrow[2] should not be less than x, the
#' number of clusters.
#' @param ytrue The vector of true class labels. If supplied, a different color is used for each true
#' cluster. Otherwise, the maximum-plausibility clusters are used instead.
#' @param Outliers If TRUE, the outliers are plotted, and they are not included in the lower
#' and upper approximations of the clusters.
#' @param Approx If Approx==1 (default), the lower and upper cluster approximations are
#' computed using the interval dominance rule. Otherwise, the maximum mass rule is used.
#' @param cex Maximum size of data points.
#' @param cexvar Parameter determining if the size of the data points is proportional to the 
#' plausibilities ('pl', the default), the plausibilities of the normalized credal partition
#' ('pl.n'), the degrees of belief ('bel'), the degrees of belief of the normalized credal partition
#' ('bel.n'), or if it is constant ('cst', default).
#' @param cex_outliers Size of data points for outliers.
#' @param cex_protos Size of data points for prototypes (if applicable).
#' @param lwd Line width for drawing the lower and upper approximations.
#' @param ask	Logical; if TRUE, the user is asked before each plot.
#' @param plot_Shepard	Logical; if TRUE and if the credal partition was generated by kevclus
#' the Shepard diagram is plotted.
#' @param plot_approx	Logical; if TRUE (default) the convex hulls of the lower and upper approximations
#' are plotted.
#' @param plot_protos	Logical; if TRUE (default) the prototypes are plotted (for methods generating
#' prototypes, like ECM).
#' @param xlab Label of horizontal axis.
#' @param ylab Label of vertical axis.
#'
#' @return The maximum plausibility hard partition, as well as the lower and upper approximations
#' of each cluster are drawn in the two-dimensional space specified by matrix \code{X}. If
#' prototypes are defined (for methods \code{"ecm"} and \code{"cecm"}), they are also
#' represented on the plot.  For methods \code{"kevclus"}, \code{"kcevclus"} or \code{"nnevclus"}  
#' a second plot with Shepard's diagram (degrees of conflict vs. transformed dissimilarities) is drawn. 
#' If input \code{X} is not supplied and the Shepard diagram exists, then only the Shepard diagram is drawn.
#'
#' @export
#' @method plot credpart
#' @importFrom graphics abline par plot points polygon
#' @importFrom grDevices chull
#'
#' @seealso \code{\link{extractMass}}, \code{\link{summary.credpart}}, \code{\link{ecm}},
#' \code{\link{recm}}, \code{\link{cecm}}, \code{\link{kevclus}}.
#'
#' @references
#' T. Denoeux and O. Kanjanatarakul. Beyond Fuzzy, Possibilistic and Rough: An
#' Investigation of Belief Functions in Clustering. 8th International conference on soft
#' methods in probability and statistics, Rome, 12-14 September, 2016.
#'
#' M.-H. Masson and T. Denoeux. ECM: An evidential version of the fuzzy c-means algorithm.
#' Pattern Recognition, Vol. 41, Issue 4, pages 1384--1397, 2008.
#'
#'T. Denoeux, S. Sriboonchitta and O. Kanjanatarakul. Evidential clustering of large
#'dissimilarity data. Knowledge-Based Systems, vol. 106, pages 179-195, 2016.
#'
#' @examples
#' ## Example with Four-class data
#' data("fourclass")
#' x<-fourclass[,1:2]
#' y<-fourclass[,3]
#' c=4
#' ## Running k-EVCLUS with singletons
#' clus<-kevclus(x=x,k=100,c=c,type='simple')
#' ## Plot the results
#' plot(clus,X=x,mfrow=c(2,2),ytrue=y)
plot.credpart <- function(x,X=NULL,...,mfrow=c(1,1),ytrue=NULL,Outliers=TRUE,Approx=1,cex=1,
                          cexvar='pl',cex_outliers=1.3,cex_protos=1,lwd=2,
                          ask=FALSE,plot_Shepard=FALSE,plot_approx=TRUE,
                          plot_protos=TRUE,xlab=expression(x[1]),ylab=expression(x[2])){
  clus<-x
  if(!is.null(X)){
    x<-X
    y<-ytrue
    par(ask=ask)

    if((mfrow[1]==1) & (mfrow[2]==1)) oneWindow<-TRUE else oneWindow<-FALSE

    if(is.null(y)) y<-clus$y.pl
    c<-max(clus$y.pl)

    if(Approx==1){
      lower.approx<-clus$lower.approx.nd
      upper.approx<-clus$upper.approx.nd
    }else{
      lower.approx<-clus$lower.approx
      upper.approx<-clus$upper.approx
    }

    if(Outliers==TRUE){
      for(i in 1:c){
        lower.approx[[i]]<-setdiff(lower.approx[[i]],clus$outlier)
        upper.approx[[i]]<-setdiff(upper.approx[[i]],clus$outlier)
      }
    }
    
    if(cexvar=='pl'){
    cex<-cex*apply(clus$pl,1,max)} else if(cexvar=='pl.n'){
      cex<-cex*apply(clus$pl.n,1,max)} else if(cexvar=='bel'){
        cex<-cex*apply(clus$bel,1,max)} else if(cexvar=='bel.n') cex<-cex*apply(clus$bel.n,1,max)
    
    if(oneWindow){
      plot(x[,1],x[,2],pch=clus$y.pl+1,col=y,cex=cex,
           xlab=xlab,ylab=ylab)
      if(Outliers==TRUE) points(x[clus$outlier,1],x[clus$outlier,2],pch=1,
                                cex=cex_outliers)
      if(!is.null(clus$g) & plot_protos) points(clus$g[,1],clus$g[,2],pch=19,cex=cex_protos)
    } else par(mfrow=mfrow)

    for(i in (1:c)){
      if(!oneWindow){
        ii<-which(clus$y.pl==i)
        # if(cexvar=='pl'){
        # cex<-cex*clus$pl[,i]} else if(cexvar=='pl.n'){
        #   cex<-cex*clus$pl.n[,i]} else if(cexvar=='bel'){
        #     cex<-cex*clus$bel[,i]} else if(cexvar=='bel.n') cex<-cex*clus$bel.n[,i]
        plot(x[,1],x[,2],xlab=xlab,ylab=ylab,type="n",main=paste("Cluster",i))
        points(x[ii,1],x[ii,2],pch=i+1,col=y[ii],cex=cex[ii])
        points(x[-ii,1],x[-ii,2],pch='.',col=y[-ii])
        out<-intersect(clus$outlier,ii)
        if(Outliers==TRUE) points(x[out,1],x[out,2],pch=1,cex=cex_outliers)
        if(!is.null(clus$g) & plot_protos) points(clus$g[,1],clus$g[,2],pch=19,cex=cex_protos)
      } # if multiple windows
      if(plot_approx){
        xx<-x[lower.approx[[i]],]
        if(oneWindow) icol<-i else icol<-1
        if(nrow(xx)>=3) polygon(xx[chull(xx),],lwd=lwd,border=icol)
        xx<-x[upper.approx[[i]],]
        if(nrow(xx)>=3) polygon(xx[chull(xx),],lty = 2,lwd=lwd,border=icol)
      }
    } # for(i in (1:c))
    par(mfrow=c(1,1))
  } # if(!is.null(X))

  # Shepard diagram
  if(((clus$method=="kevclus") | (clus$method=="kcevclus") | 
      (clus$method=="nn-evclus")) & plot_Shepard){
    n<-nrow(clus$D)
    if(n>100) symb<-'.' else symb<-1
    plot(as.vector(clus$D),as.vector(clus$Kmat),pty="s",main="Shepard diagram",
          xlab="transformed dissimilarities",ylab="degrees of conflict",pch=symb)
    abline(0,1)
  } 
}