R/bdm_plot.R

In bigMap: Big Data Mapping

# +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
# The bigMap Package for R.

# Copyright (c) 2018, Joan Garriga <jgarriga@ceab.csic.es>, Frederic Bartumeus <fbartu@ceab.csic.es> (Blanes Centre for Advanced Studies, CEAB-CSIC).

# bigMap is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version.

# bigMap is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details.

# You should have received a copy of the GNU General Public License along with this program. If not, see http://www.gnu.org/licenses.
# +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

# -----------------------------------------------------------------------------
# +++ ptSNE plots
# -----------------------------------------------------------------------------

#' ptSNE cost & size plot.
#'
#' @param bdm A \var{bdm} instance as generated by \code{bdm.init()} or a list of them to make a comparative plot.
#'
#' @param offset X-axis offset in number of epochs (0 by default).
#'
#' @return None.
#'
#' @examples
#'
#' bdm.example()
#' bdm.cost(exMap)

bdm.cost <- function(bdm, offset=0)
{
	if (is.null(bdm$dSet)) bdm.list <- bdm
	else bdm.list <- list(bdm)

	# set graphic environment
	parbdm.set(mar=c(4.5,4.5,3,4.5), mgp=c(1.0,0.6,0), cex.axis=1.2)
	layout(layout.get(length(bdm.list)))

	nulL <- lapply(bdm.list, function(bdm)
	{
		ptsne.cost(bdm, offset=offset)
	})

	# fill layout
	if (length(bdm.list) < max(layout.get(length(bdm.list)))) plot.null()
	# reset graphic environment
	parbdm.def()

}

# +++ Plot cost/size internal function.

ptsne.cost <- function(bdm, offset=0, movie=F, mtext.cex=1.2)
{
	if (!is.null(bdm$ptsne$Y))
	{
		x <- offset:(ncol(bdm$ptsne$cost)-1)
		y <- x +1
		cost.clr <- brewer.pal(5, 'Purples')
		plot(x, bdm$ptsne$cost[1, y], type='l', col=cost.clr[2], axes=F, xlab='', ylab='', ylim=range(bdm$ptsne$cost))
		nulL <- sapply(seq(2, nrow(bdm$ptsne$cost)), function(l)
		{
			lines(x, bdm$ptsne$cost[l, y], col=cost.clr[2])
		})
		lines(x, apply(bdm$ptsne$cost[ ,y], 2, mean), col=cost.clr[5], lwd=1.5)
		axis(side=1, at=pretty(range(x)), tick=T)
		if (!movie) mtext("epochs", side=1, line=ifelse((mtext.cex==1.2), 3, 2), cex=mtext.cex)
		axis(side=2, at=pretty(range(bdm$ptsne$cost)), tick=T, las=1, col=cost.clr[5])
		mtext("Cost", side=2, line=ifelse((mtext.cex==1.2), 3, 2), col=cost.clr[5], cex=mtext.cex)
		if (!is.null(bdm$ptsne$size))
		{
				par(new = T)
				size.clr <- brewer.pal(5, 'PuRd')
				plot(x, bdm$ptsne$size[1, y], type='l', col=size.clr[2], axes=F, xlab='', ylab='', ylim=range(bdm$ptsne$size))
				nulL <- sapply(seq(2, nrow(bdm$ptsne$size)), function(l)
				{
					lines(x, bdm$ptsne$size[l, y], col=size.clr[2])
				})
				lines(x, apply(bdm$ptsne$size[ ,y], 2, mean), col=size.clr[5], lwd=1.5)
				axis(side=4, at=pretty(range(bdm$ptsne$size)), tick=T, las=1, col=size.clr[5])
				mtext("Size", side=4, line=ifelse((mtext.cex==1.2), 3, 1.5), col=size.clr[5], cex=mtext.cex)
		}
	}
}

#' Plot ptSNE (low-dimensional embedding)
#'
#' @param bdm A \var{bdm} instance as generated by \code{bdm.init()} or a list of them to make a comparative plot.
#'
#' @param ptsne.cex The size of the mapped data-points in the ptSNE plot. Default value is \code{ptsne.cex = 0.5}.
#'
#' @param ptsne.bg The background colour of the ptSNE plot. Default value is \code{ptsne.bg = #FFFFFF} (white).
#'
#' @param class.pltt A colour palette to show class labels in the ptSNE plot. If \code{!is.null(bdm$wtt)} cluster labels are used by default, else if \code{!is.null(bdm$lbls)} are used by default. If \code{ptsne.pltt = NULL} (default value) the default palette is used. 
#'
#' @param layer The \var{bdm$ptsne} layer to be used (default value is \code{layer = 1}).
#'
#' @return None.
#'
#' @examples
#'
#' bdm.example()
#' exMap <- bdm.ptsne.plot(exMap)

bdm.ptsne.plot <- function(bdm, ptsne.cex = 0.5, ptsne.bg = '#FFFFFF', class.pltt = NULL, layer = 1)
{
	if (is.null(bdm$dSet)) bdm.list <- bdm
	else bdm.list <- list(bdm)
	# set graphic environment
	parbdm.set(oma = c(0.8, 0.8, 0.8, 0.8), mar = c(2.8, 2.8, 0.5, 0.5), mgp=c(1.8,0.6,0), cex.axis=1.0)
	layout(layout.get(length(bdm.list)))
	nulL <- lapply(bdm.list, function(bdm)
	{
		if (!is.null(bdm$ptsne)) {
			ptsne.plot(bdm, layer = layer, cex = ptsne.cex, bg = ptsne.bg, pltt = class.pltt)
		}
		else {
			plot.null()
			return(message('+++ Error: no ptSNE found \n'))
		}
	})
	# fill layout
	if (length(bdm.list) < max(layout.get(length(bdm.list)))) plot.null()
	# reset graphic environment
	parbdm.def()
}

#' Plot paKDE (density landscape)
#'
#' @param bdm A \var{bdm} instance as generated by \code{bdm.init()} or a list of them to make a comparative plot.
#'
#' @param pakde.pltt A colour palette to show levels in the paKDE plot. By default (\code{pakde.pltt = NULL}) the default palette is used.
#'
#' @param pakde.lvls The number of levels of the density heat-map (16 by default).
#'
#' @param layer The \var{bdm$ptsne} layer to be used (default value is \code{layer = 1}).
#'
#' @return None.
#'
#' @examples
#'
#' bdm.example()
#' exMap <- bdm.pakde.plot(exMap)

bdm.pakde.plot <- function(bdm, pakde.pltt = NULL, pakde.lvls = 16, layer = 1)
{
	if (is.null(bdm$dSet)) bdm.list <- bdm
	else bdm.list <- list(bdm)
	# set graphic environment
	parbdm.set(oma = c(0.8, 0.8, 0.8, 0.8), mar = c(2.8, 2.8, 0.5, 0.5), mgp=c(1.8,0.6,0), cex.axis=1.0)
	layout(layout.get(length(bdm.list)))
	nulL <- lapply(bdm.list, function(bdm)
	{
		if (is.null(bdm$pakde)) {
			plot.null()
			return(message('+++ Error: no ptSNE found \n'))
		}
		else {
			pakde <- bdm$pakde[[layer]]
			plot.pakde(pakde, pakde.pltt, pakde.lvls)
		}
	})
	# fill layout
	if (length(bdm.list) < max(layout.get(length(bdm.list)))) plot.null()
	# reset graphic environment
	parbdm.def()
}

#' Plot WTT (clustering)
#'
#' @param bdm A \var{bdm} instance as generated by \code{bdm.init()} or a list of them to make a comparative plot.
#'
#' @param pakde.pltt A colour palette to show levels in the paKDE plot. By default (\code{pakde.pltt = NULL}) the default palette is used.
#'
#' @param pakde.lvls The number of levels of the density heat-map (16 by default).
#'
#' @param wtt.lwd The width of the watertrack lines (as set in \code{par()}).
#'
#' @param plot.peaks Logical value (TRUE by default). If set to TRUE and the up-stream step \code{bdm$wtt()} is computed marks the peak of each cluster.
#'
#' @param labels.cex If \var{plot.peaks} is TRUE, the size of the labels of the clusters (as set in \code{par()}). By default \code{labels.cex = 0.0} and the labels of the clusters are not depicted.
#'
#' @param layer The \var{bdm$ptsne} layer to be used (default value is \code{layer = 1}).
#'
#' @return None.
#'
#' @examples
#'
#' bdm.example()
#' exMap <- bdm.wtt.plot(exMap)

bdm.wtt.plot <- function(bdm, pakde.pltt = NULL, pakde.lvls = 16, wtt.lwd = 1.0, plot.peaks = T, labels.cex = 1.0, layer = 1)
{
	if (is.null(bdm$dSet)) bdm.list <- bdm
	else bdm.list <- list(bdm)
	# set graphic environment
	parbdm.set(oma = c(0.8, 0.8, 0.8, 0.8), mar = c(2.8, 2.8, 0.5, 0.5), mgp=c(1.8,0.6,0), cex.axis=1.0)
	layout(layout.get(length(bdm.list)))
	nulL <- lapply(bdm.list, function(bdm)
	{
		if (is.null(bdm$pakde)) {
			plot.null()
			return(message('+++ Error: no ptSNE found \n'))
		}
		else {
			pakde <- bdm$pakde[[layer]]
			plot.pakde(pakde, pakde.pltt, pakde.lvls)
			if (!is.null(bdm$wtt) && layer <= length(bdm$wtt))
			{
				wtt <- bdm$wtt[[layer]]
				if (!is.null(bdm$merge)) {
					plot.wtt(pakde, bdm$merge$C, wtt$grid, 2*wtt.lwd, '#555555')
					wtt.lwd <- wtt.lwd * 0.5
				}
				plot.wtt(pakde, wtt$C, wtt$grid, wtt.lwd, '#CCCCCC')
				if (plot.peaks) {
					if (!is.null(bdm$merge)) C <- bdm$merge$C
					else C <- wtt$C
					wtt.peaks(pakde, wtt, C, labels.cex)
				}
			}
		}
	})
	# fill layout
	if (length(bdm.list) < max(layout.get(length(bdm.list)))) plot.null()
	# reset graphic environment
	parbdm.def()
}

# ------------------------------------------------------------------------------
# +++ ptSNE scatterplot (internal)
# ------------------------------------------------------------------------------

ptsne.plot <- function(bdm, pltt = NULL, cex = 0.3, bg = '#FFFFFF', layer = 1)
{
	if (!is.null(bdm$lbls)){
		L <- bdm$lbls
	}
	else {
		L <- bdm.labels(bdm, layer = layer)
	}
	if (is.null(pltt)) pltt <- pltt.get(length(unique(L)))

	l <- c(1, 2) + (layer -1) *2
	par(bg = bg)
	plot(bdm$ptsne$Y[, l], xlab = 'Y1', ylab = 'Y2', col = pltt[L], pch = 20, cex = cex, cex.lab = 1.0)

}

# ------------------------------------------------------------------------------
# +++ plot pakde (internal)
# ------------------------------------------------------------------------------

plot.pakde <- function(pakde, pltt, lvls)
{
	if (is.null(pltt)) pltt <- pltt.pakde(lvls)
	image(pakde$x, pakde$y, pakde$z, col = pltt, xaxt='n', yaxt='n', xlab='', ylab='', )
}

# ------------------------------------------------------------------------------
# +++ plot wtt.lines (internal)
# ------------------------------------------------------------------------------

plot.wtt <- function(pakde, C, grid, lwd, col)
{
	nulL <- sapply(seq_along(C), function(n)
	{
		n2c <- as.numeric(grid_n2cell(n-1, grid)) +1
		n.cross <- as.numeric(grid_cross(n-1, grid)) + 1
		nulL <- sapply(n.cross, function(m)
		{
			if (m > n && C[n] != C[m]) {
				m2c <- as.numeric(grid_n2cell(m-1, grid)) +1
				if (n2c[1] != m2c[1]) {
					lines(pakde$x[c(m2c[1], m2c[1])], pakde$y[c(n2c[2], (n2c[2]+1))], col=col, lwd=lwd)
				}
				if (n2c[2] != m2c[2]) {
					lines(pakde$x[c(n2c[1], (n2c[1]+1))], pakde$y[c(m2c[2], m2c[2])], col=col, lwd=lwd)
				}
			}
		})
	})
}


# ------------------------------------------------------------------------------
# +++ add peaks to wtt.lines plot (internal)
# ------------------------------------------------------------------------------

wtt.peaks <- function(pakde, wtt, C, labels.cex)
{
	peaks <- unique(C)
	points(pakde$x[wtt$M[peaks, 1]], pakde$y[wtt$M[peaks, 2]],  col='#000000FF', cex=1, pch=17)
	if (labels.cex > 0) {
		text(pakde$x[wtt$M[peaks, 1]], pakde$y[wtt$M[peaks, 2]], labels = peaks, pos = 3, cex = labels.cex)
	}
}