R/bdm_qMap.R

Defines functions bdm.pMap qMap.plot1 bdm.qMap

Documented in bdm.pMap bdm.qMap

# +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
# 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 quantile-maps
#'
#' Maps quantitative variables onto the embedding space.
#'
#' @param data A \code{matrix/data.frame} to be mapped.
#'
#' @param bdm A \var{bdm} instance as generated by \code{bdm.init()}.
#'
#' @param labels A length \code{nrow(bdm$data)} vector of class labels to overlay onto the embedding. Label values are factorized as \var{as.numeric(as.factor(labels))}. Default value is \var{labels = NULL}.
#'
#' @param subset A numeric vector with the indexes of a subset of data. Data-points in the subset are heat-mapped and the rest are shown in light grey. By default all data-points are heat-mapped.
#'
#' @param qMap.levels The number of levels of the quantile-map (8 by default).
#'
#' @param qMap.cex The size of the data-points (as in \code{par()}).
#'
#' @param qMap.bg The background colour of the qMap plot. Default value is \code{ptsne.bg = #FFFFFF} (white).
#'
#' @param class.pltt If \code{!is.null(labels)} or \code{!is.null(bdm$lbls)}, a colour palette to show class labels with the qMap plots. By default (\code{qMap.pltt = NULL}) the default palette is used.
#'
#' @param qtitle A vector of strings with titles for the plots. Default value is \code{qtitle=NULL}.
#'
#' @param cex.main The font size of the title (as in \code{par()}).
#'
#' @param colorbar A logical value (TRUE by default). FALSE hides the side colorbar.
#'
#' @param layer The number of a layer (1 by default).
#'
#' @return None.
#'
#' @details This is not a heat-map but a quantile-map plot. This function splits the range of each variable into as many quantiles as specified by \var{levels} so that the color gradient will hardly ever correspond to a constant numeric gradient. Thus, the mapping will show more evenly distributed colors though at the expense of possibly exaggerating artifacts. For variables with very extrem distributions, it will be impossible to find as many quantiles as desired and the distribution of colors will not be so homogeneous.
#' @examples
#'
#' bdm.example()
#' bdm.qMap(ex$map, ex$data)
#' # --- show only components (1, 2, 4, 8) of the GMM
#' bdm.qMap(ex$map, ex$data, subset = which(ex$map$lbls %in% c(1, 4, 8, 16)))

bdm.qMap <- function(bdm, data, labels = NULL, subset = NULL, qMap.levels = 8, qMap.cex = 0.3, qMap.bg = '#FFFFFF', class.pltt = NULL, qtitle =NULL, cex.main = 1.0, colorbar = T, layer = 1)
{
	# get data
	if (is.null(data))
		return(message('+++ Error: no data given !'))

	# check 1 single plot
	if (is.null(ncol(data))){
		qMap.plot1(bdm, as.numeric(data), qMap.levels = qMap.levels, qMap.cex = qMap.cex, qMap.bg = qMap.bg, qtitle = qtitle, cex.main = cex.main, colorbar = colorbar)
		return()
	}

	# get labels
	if (!is.null(labels)) labels <- as.numeric(as.factor(labels))

	# get var names
	if (is.null(colnames(data))) {
		colnames(data) <- paste('V', formatC(seq(ncol(data)), width = 2, flag = '0'), sep = '.')
	}

	# join labels & data
	if (!is.null(labels)) data <- cbind(labels, data)

	# check number of vars
	if (ncol(data) > 20) {
		data <- data[, 1:20]
		cat('+++ WARNING: plotting first ', ncol(data) - !is.null(labels), ' columns !, \n', sep='')
	}

	# get mapping
	l <- c(1, 2) + (layer -1) *2
	Y <- bdm$ptsne$Y[ , l]

	# set graphic environment (Att!! with this)
	if (colorbar)
	{
		layout.mtx <- t(cbind(layout.get(ncol(data)), layout.get(ncol(data))))
		layout.mtx[ , ] <- seq(length(layout.mtx))
		layout.mtx <- t(layout.mtx)
		layout(layout.mtx, widths = rep(2 /ncol(layout.mtx) *c(0.73, 0.27), ncol(layout.mtx)))
	} else
	{
		layout.mtx <- layout.get(ncol(data))
		layout.mtx[ , ] <- seq(length(layout.mtx))
		layout.mtx <- t(layout.mtx)
		layout(layout.mtx)
	}
	c1 <- c(4.5, 3.5, 2.5, 1.5, 0.5)
	c3 <- c(8, 7, 6, 5, 4)
	parbdm.set(oma = c(c1[nrow(layout.mtx)], 1, c3[nrow(layout.mtx)], 1))

	# legend palette
	hmap.pltt <- c(pltt.heat(qMap.levels), '#DDDDDDFF')

	nulL <- lapply(seq(ncol(data)), function(j){
		if (j == 1 & !is.null(labels)) {
			X <- data[, j]
			if (is.null(class.pltt))
				pltt <- c(pltt.get(s = length(unique(X))), '#DDDDDDFF')
			else
				pltt <- class.pltt
		}
		else {
			# factor data
			X <- get.lvls(data[, j], qMap.levels)
			Q <- quantile(data[, j][!is.na(data[, j])], seq(0, 1, length.out = qMap.levels+1))
			pltt <- hmap.pltt
		}
		# plot q-maps
		par(mar = c(1.0, 1.0, 0.8, 0.4))
		if (!is.null(subset)) {
			# plot shadow
			plot(Y[-subset, ], xaxt = 'n', xlab = '', yaxt = 'n', ylab = '', xlim = range(Y[,1]), ylim = range(Y[,2]), col = pltt[length(pltt)], cex = qMap.cex, pch = 20, asp = 1, main = colnames(data)[j], cex.main = cex.main)
			# plot subset q-map
			points(Y[subset, ], col = pltt[X[subset]], cex = qMap.cex, pch = 20, asp = 1)
		}
		else {
			# plot q-map
			plot(Y, xaxt = 'n', yaxt = 'n', xlab = '', ylab = '', xlim = range(Y[, 1]), ylim = range(Y[, 2]), col = pltt[X], cex = qMap.cex, pch = 20, asp = 1, main = colnames(data)[j], cex.main = cex.main)
		}
		# plot title
		# title(colnames(data)[j], line = 1.0, outer = T, cex.sub = 0.8)
		# mtext(colnames(data)[j], side = 3, line = 2.0, at = 1.1 *min(Y[, 1]), cex = 1.0, pos = 'right')
		# text(0.8 *min(Y[, 1]), 0.9 *max(Y[, 2]), labels = colnames(data)[j], cex = 1.0)
		# plot legend
		if (colorbar)
		{
			par(mar = c(1, 0.1, 0.5, 0.1))
			plot(1, 1, xlab = '', ylab = '', xaxt = "n", yaxt = "n", bty = "n", type = "n")
			if (j == 1 & !is.null(labels)) {
				s <- length(unique(labels))
				lgnd.lbls <- formatC(seq(s), width = 3)
				legend('center', legend = lgnd.lbls[s:1], bty = 'n', pch = 15, cex = 0.6, pt.cex = 1.6, y.intersp = 0.7, col = pltt[s:1])
			} else {
				lgnd.lbls <- sapply(seq(qMap.levels), function(l) {
					if (l == 1 || Q[l] != Q[l-1]) {
						formatC(Q[l], format = 'e', digits = 2)
					} else {
						' '
					}
				})
				legend('center', legend = lgnd.lbls[qMap.levels:1], bty = 'n', pch = 15, cex = 0.6, pt.cex = 1.6, y.intersp = 0.7, col = pltt[qMap.levels:1])
			}
		}
	})

	# fill layout
	if (length(ncol(data)) < max(layout.get(length(ncol(data))))) plot.null()
	# layout title
	if (is.null(qtitle)) qtitle <- bdm$dSet
	title(qtitle, outer = T, cex.main = 1.0)
	# reset graphic environment
	parbdm.def()
}

qMap.plot1 <- function(bdm, data, qMap.levels = 8, qMap.cex = 0.3, qMap.bg = '#FFFFFF', qtitle =NULL, cex.main = 1.0, colorbar = T)
{
	# get data
	if (is.null(data))
		return(message('+++ Error: no data given !'))
	# get mapping
	Y <- bdm$ptsne$Y[ , 1:2]

	# set graphic environment (Att!! with this)
	if (colorbar) layout(matrix(1:2, nrow = 1), widths = c(0.73, 0.27))
	parbdm.set(oma = c(0.5, 0.5, 2.0, 0.5))

	# legend palette
	hmap.pltt <- c(pltt.heat(qMap.levels), '#DDDDDDFF')

	# factor data
	X <- get.lvls(data, qMap.levels)
	Q <- quantile(data[!is.na(data)], seq(0, 1, length.out = qMap.levels+1))
	pltt <- hmap.pltt
	par(mar = c(1.0, 1.0, 2.0, 0.4))
	# plot q-map
	plot(Y, xaxt = 'n', yaxt = 'n', xlab = '', ylab = '', xlim = range(Y[, 1]), ylim = range(Y[, 2]), col = pltt[X], cex = qMap.cex, pch = 20, asp = 1, main = qtitle, cex.main = cex.main)
	# plot legend
	if (colorbar)
	{
		par(mar = c(1, 0.1, 2.0, 0.1))
		plot(1, 1, xlab = '', ylab = '', xaxt = "n", yaxt = "n", bty = "n", type = "n")
		lgnd.lbls <- sapply(seq(qMap.levels), function(l) {
			if (l == 1 || Q[l] != Q[l-1]) {
				formatC(Q[l], format = 'e', digits = 2)
			} else {
				' '
			}
		})
		legend('center', legend = lgnd.lbls[qMap.levels:1], bty = 'n', pch = 15, cex = 1.0, pt.cex = 2.0, y.intersp = 1.0, col = pltt[qMap.levels:1])
	}
	# reset graphic environment
	parbdm.def()
}


#' Precision map (quantile map of betas)
#'
#' @param bdm A \var{bdm} instance as generated by \code{bdm.init()}.
#'
#' @param pMap.levels The number of levels of the quantile-map (8 by default).
#'
#' @param pMap.cex The size of the data-points (as in \code{par()}). Default value is \code{ptsne.cex = 0.1}.
#'
#' @param pMap.bg The background colour of the qMap plot. Default value is \code{ptsne.bg = #FFFFFF} (white).
#'
#' @param colorbar A logical value (TRUE by default). FALSE hides the side colorbar.
#'
#' @return None.
#'
#' @examples
#'
#' bdm.example()
#' bdm.pMap(ex$map)

bdm.pMap <- function(bdm, pMap.levels = 8, pMap.cex = 0.1, pMap.bg = '#000000', colorbar = T)
{
	# get mapping
	Y <- bdm$ptsne$Y[, 1:2]

	# legend palette
	if (pMap.bg == '#000000')
		pltt <- c(pltt.heat(pMap.levels), '#DDDDDD')
	else
		pltt <- c(pltt.heat(pMap.levels), '#000000')

	#factor data
	data <- bdm$ppx$B[, 1]
	X <- get.lvls(data, pMap.levels)
	Q <- quantile(data, seq(0, 1, length.out = pMap.levels+1))

	# set graphic environment
	parbdm.set(oma = c(1.0, 1.0, 1.0, 1.0), mar = c(1.0, 1.0, 0.2, 0.4), bg = pMap.bg)
	layout(matrix(seq(2), nrow = 1), widths = c(0.73, 0.27))

	# plot q-map
	plot(Y, xaxt = 'n', yaxt = 'n', bty = 'n', xlab = '', ylab = '', xlim = range(Y[, 1]), ylim = range(Y[, 2]), col = pltt[X], cex = pMap.cex, pch = 20, asp = 1)
	# plot legend
	if (colorbar)
	{
		par(mar = c(1.0, 0.1, 0.2, 0.1))
		plot(1, 1, xlab = '', ylab = '', xaxt = "n", yaxt = "n", bty = "n", type = "n")
		lgnd.lbls <- sapply(seq(pMap.levels), function(l) {
			if (l == 1 || Q[l] != Q[l-1]) {
				formatC(Q[l], format = 'e', digits = 2)
			} else {
				' '
			}
		})
		legend('center', legend = lgnd.lbls[pMap.levels:1], bty = 'n', pch = 15, cex = 1.2, pt.cex = 1.2, y.intersp = 1.1, col = pltt[pMap.levels:1], text.col = pltt[length(pltt)])
	}
	# reset graphic environment
	parbdm.def()
}
jgarriga65/bigMap documentation built on June 10, 2024, 7:05 a.m.