R/plot_patterns.R

In GridOnClusters: Cluster-Preserving Multivariate Joint Grid Discretization

# plot_patterns.R
# Created by Mingzhou Song
# Modified by Jiandong Wang and Sajal Kumar
#    Dec 6, 2021. Added function plot.GridOnClusters()
# Copyright (c) NMSU Song lab

#' Plotting the continuous data along with cluster-preserving Grid
#' 
#' Plots examples of jointly discretizing continuous data based on grids that 
#' preserve clusters in the original data.
#' 
#' @importFrom grDevices colorRampPalette palette
#' @importFrom graphics abline legend mtext par plot strheight strwidth
#' @importFrom plotrix color.legend
#' 
#'
#' @param x the result generated by discretize.jointly
#' @param xlab the horizontal axis label
#' @param ylab the vertical axis label
#' @param main the title of the clustering scatter plots
#' @param main.table the title of the discretized data plots
#' @param sub the subtitle
#' @param pch the symbol for points on the scatter plots
#' @param ... additional graphical parameters
#' 
#' @export
plot.GridOnClusters = function(
   x, xlab=NULL, ylab=NULL, main=NULL, 
   main.table=NULL, sub=NULL, pch = 19,  ...)
{
   k = length(unique(x$clabels))
   mar = c(2.5,2.5,2.5,3.5)
   par(mar=mar, mgp=c(3,1,0)-c(1.5,0.5,0), lwd=2)
   dims = dim(x$data)[2]

   
   #col.palette = palette()[-1]
   l = 0
   for(i in c(1:(dims-1))){
      for(j in c((i+1):dims)){
         l = l + 1
         
         #if(is.null(xlab)) xlab <- paste0("dimension ",i)
         #if(is.null(ylab)) ylab <- paste0("dimension ",j)
          xlab <- paste0("dimension ",i)
          ylab <- paste0("dimension ",j)
         if(is.null(main)) main <- paste0("Original Data\nMethod = ", x$method)
         if(is.null(main.table)) main.table <- paste0("Discretized Data\nMethod = ", x$method)
               
         #col <- col.palette[l]
         #labelcol <- colorRampPalette(c("black", col))
         #plot(x$data[,i], x$data[,j], main="", col=labelcol(k)[x$clabels], 
         #     pch=19, cex.axis=0.8, cex=0.7, xlab = xlab, ylab = ylab)
         plot(x$data[,i], x$data[,j], main="", col=x$clabels, 
              pch=pch, cex.axis=0.8, cex=0.7, xlab = xlab, ylab = ylab)
         mtext(text = main, side = 3, line = 0.25, cex=1.125)
         abline(v=x$grid[[i]], h=x$grid[[j]], col="black", lty="dotted")
         tab <- as.matrix(table(-x$D[, j], x$D[, i]))
         coord <- par("usr")
         #color.legend(xl = coord[2]+strwidth("0")*3,
         #             xr = coord[2]+strwidth("0")*5,
         #             yb = mean(c(coord[4],coord[3])), 
         #             yt = coord[4], 
         #             legend = seq(length(unique(x$clabels))),
         #             rect.col = unique(labelcol(k)[seq(length(unique(x$clabels)))]), 
         #             gradient="y")
         FunChisq::plot_table(
            tab, xlab=xlab, ylab=ylab, # col=x$clabels, 
            main=main.table, highlight="none", value.cex=4/max(dim(tab)),
            mar = c(2.5, 2.5, 2.5, 2.5))
      }
   }
}


#' (OBOSOLETE) Plotting the continuous data along with cluster-preserving Grid
#' 
#' Plots examples of jointly discretizing continuous data based on grids that 
#' preserve clusters in the original data.
#' 
#' @param data the input continuous data matrix
#' @param res the result generated by discretize.jointly
#' 
#' @export
plotGOCpatterns = function(data, res)
{
   k = length(unique(res$clabels))
   mar = c(2.5,2.5,2.5,3.5)
   par(mar=mar, mgp=c(3,1,0)-c(1.5,0.5,0), lwd=2)
   dims = dim(data)[2]
   
   col.palette = palette()[-1]
   l = 0
   for(i in c(1:(dims-1))){
      for(j in c((i+1):dims)){
         l = l + 1
         col <- col.palette[l]
         labelcol <- colorRampPalette(c("black", col))
         plot(data[,i], data[,j], main="", col=labelcol(k)[res$clabels], 
              pch=19, cex.axis=0.8, cex=0.7, xlab = paste0("dimension ",i), ylab = paste0("dimension ",j))
         mtext(text = "Original Data", side = 3, line = 1, cex=1.5)
         abline(v=res$grid[[i]], h=res$grid[[j]], col="black", lty="dotted")
         tab <- as.matrix(table(-res$D[, j], res$D[, i]))
         coord <- par("usr")
         color.legend(xl = coord[2]+strwidth("0")*3,
                      xr = coord[2]+strwidth("0")*5,
                      yb = mean(c(coord[4],coord[3])), 
                      yt = coord[4], 
                      legend = seq(length(unique(res$clabels))),
                      rect.col = unique(labelcol(k)[seq(length(unique(res$clabels)))]), 
                      gradient="y")
         FunChisq::plot_table(
            tab, xlab=paste0("dimension ",i), ylab=paste0("dimension ",j),
            col=col, main="Discretized data", highlight="none", 
            mar = c(2.5, 2.5, 2.5, 2.5))
      }
   }
}