This is an implementation of Gábor Csárdi’s crayon R package to draw heatmaps directly in the terminal using 256-color ANSI specification. Rendering in the HTML Markdown is made possible thanks to Brodie Gaslam’s fansi R package.
We first define the crayonmap class. For now it’s not very useful, but since the ANSI map is actually rendered as a vector by cat, it is useful to retain some info regarding the original dimensions of the matrix.
setClass("crayonmap", representation(crayons = "character", row.num = "numeric", col.num = "numeric"))We then define some important functions. The first one borrows directly from pheatmap, R package by Raivo Kolde and is used to map colors to values. Values are automatically scaled, since that is the default view of heatmaps. However this can be disabled.
#' Color key
#' @param values vector of numeric values to which colors will be mapped
#' @param pal color palette
#' @param scale logical, should values be scaled? Defaults to TRUE
#' @return a vector of colors, mapped to the values and in the same order as the values vector
#' @author Giuseppe D'Agostino
colorKey <- function(values,
pal = colorRampPalette(c("red", "gray", "blue"))(24),
scale = TRUE)
{
require(pheatmap)
if(scale == TRUE) values_sc <- scale(values) else values_sc <- values
bks <- pheatmap:::generate_breaks(values_sc, length(pal), center = F)
cols <- pheatmap:::scale_colours(values_sc, col=pal, breaks=bks, na_col = "gray")
cols <- as.character(cols)
return(cols)
} Then a placeholder function to print a crayonmap class object. This is not yet very useful, but I will add some functionalities in the future.
paintCrayon <- function(cmap)
{
if(!is(cmap, "crayonmap")) stop("Must supply a crayonmap object.")
cat(cmap@crayons, sep = "")
}Then we define the actual function to plot the heatmap. Its setup borrows heavily from pheatmap. Clustering is allowed, both on rows and columns, and the user can choose among several distance methods (as accepted by dist) and several clustering methods (as accepted by hclust). A plot title and key title can be also provided. The column legend is shown separately because column names do not fit in the slim margin of three white spaces (which make up the coloured block in the heatmap). In the future I will add pheatmap-style annotations, and maybe dendrograms. The trick that makes this function fast is adding endlines to the 2D matrix and then flattening the matrix in a single character vector. This way the application of cat to print the heatmap is vectorized.
#' Text-based heatmap,
#' @param dat matrix with numeric values, rownames and colnames
#' @param cols color palette
#' @param cluster_cols logical, should columns be clustered by hierarchical clustering? default is TRUE
#' @param cluster_rows logical, should rows be clustered by hierarchical clustering? default is TRUE
#' @param dist_method character, distance method used by dist
#' @param clustering_method character, clustering method used by hclust
#' @param main character, title of the heatmap
#' @param key character, title of the color legend
#' @param show_col_legend logical, should the column legend be shown at the end of the plot? default is TRUE
#' @return a text-based heatmap directly in the terminal output using ANSI background styles. Useful when your X11 forwarding is broken or for quick exploratory analysis of small datasets. Setup is largely inspired by pheatmap.
textHeatmap <-function(dat,
pal = colorRampPalette(c("red", "gray", "blue"))(24),
cluster_cols = TRUE,
cluster_rows = TRUE,
dist_method = "euclidean",
clustering_method = "complete",
main = "Heatmap",
key = "Key",
show_col_legend = TRUE)
{
require(crayon)
#Clustering
if(cluster_rows == TRUE){
hr = hclust( #Hierarchical clustering of the rows
dist(dat, method = dist_method),
method = clustering_method
)
} else {
hr = list("order" = 1:nrow(dat))
}
if(cluster_cols == TRUE){
hc = hclust(
dist(t(dat), method = dist_method), #Hierarchical clustering of columns (same as rows but transposing the matrix)
method = clustering_method)
} else {
hc = list("order" = 1:ncol(dat))
}
dat = dat[hr$order, hc$order]
#Colour rendering and crayonmap object
crayonstrings <- matrix(unlist(sapply(colorKey(as.vector(dat), pal = pal), function(x) crayon::make_style(x, bg = T)(" "))), nrow = nrow(dat))
crayonstrings[,ncol(crayonstrings)] <- paste(crayonstrings[,ncol(crayonstrings)], crayon::reset(" "), rownames(dat), "\n", sep = "")
crayonstrings[,1] <- paste(" ", crayonstrings[,1], sep = "")
crayons <- as.vector(t(crayonstrings))
cmap <- new("crayonmap", crayons = crayons, row.num = nrow(dat), col.num = ncol(dat))
# Column names
#padding
cat("\n \n")
cat(" ")
for(k in 1:ncol(dat)){
if(nchar(k) == 1) cat(paste(" ",k," ", sep = ""))
else if(nchar(k) == 2) cat(paste(k, " ",sep = ""))
}
cat("\n")
#Plot the heatmap
paintCrayon(cmap)
#Color Key
#padding
cat("\n \n")
cat(" ")
ckey <- unique(unlist(sapply(pal, function(x) crayon::make_style(x, bg = TRUE)(" "))))
mid.value = round(abs((max(dat))-min(abs(dat)))/2)
cat("Key", "\n", " ", round(abs(min(dat))), rep(" ", length(ckey)/2), mid.value, rep(" ", (length(ckey)/2)-1), " ", round(abs(max(dat))), "\n", " ", ckey, "\n\n", sep = "")
#Column legend
if(show_col_legend == TRUE){
cat(" ")
cat("Column legend:\n")
for(i in 1:ncol(dat)) cat(paste(" ", i, ":", colnames(dat)[i], "\n", sep = ""))
}
}Let’s generate some toy examples. We will use fansi to set knitr hooks that will allow the visualization of ANSI in the HTML file:
hmap = matrix(0, ncol = 10, nrow = 20)
for(i in 1:10) hmap[,i] = runif(20, i, i*3)
rownames(hmap) = paste("Gene", 1:nrow(hmap))
colnames(hmap) = paste("Sample", 1:ncol(hmap))
textHeatmap(hmap)
textHeatmap(hmap, colorRampPalette(c("red", "gray", "blue"))(24))
textHeatmap(hmap, viridis::viridis(option = "B", 24))
textHeatmap(hmap, pal = colorspace::sequential_hcl("Sunset", n = 24))
textHeatmap(hmap, viridis::viridis(option = "B", 24), cluster_cols = F, cluster_rows = F)##
##
## 1 2 3 4 5 6 7 8 9 10
## Gene 6
## Gene 17
## Gene 1
## Gene 4
## Gene 14
## Gene 19
## Gene 2
## Gene 15
## Gene 11
## Gene 13
## Gene 3
## Gene 16
## Gene 10
## Gene 5
## Gene 8
## Gene 9
## Gene 12
## Gene 20
## Gene 7
## Gene 18
##
##
## Key
## 1 14 29
##
##
## Column legend:
## 1:Sample 1
## 2:Sample 2
## 3:Sample 3
## 4:Sample 4
## 5:Sample 5
## 6:Sample 6
## 7:Sample 7
## 8:Sample 8
## 9:Sample 9
## 10:Sample 10
##
##
## 1 2 3 4 5 6 7 8 9 10
## Gene 6
## Gene 17
## Gene 1
## Gene 4
## Gene 14
## Gene 19
## Gene 2
## Gene 15
## Gene 11
## Gene 13
## Gene 3
## Gene 16
## Gene 10
## Gene 5
## Gene 8
## Gene 9
## Gene 12
## Gene 20
## Gene 7
## Gene 18
##
##
## Key
## 1 14 29
##
##
## Column legend:
## 1:Sample 1
## 2:Sample 2
## 3:Sample 3
## 4:Sample 4
## 5:Sample 5
## 6:Sample 6
## 7:Sample 7
## 8:Sample 8
## 9:Sample 9
## 10:Sample 10
##
##
## 1 2 3 4 5 6 7 8 9 10
## Gene 6
## Gene 17
## Gene 1
## Gene 4
## Gene 14
## Gene 19
## Gene 2
## Gene 15
## Gene 11
## Gene 13
## Gene 3
## Gene 16
## Gene 10
## Gene 5
## Gene 8
## Gene 9
## Gene 12
## Gene 20
## Gene 7
## Gene 18
##
##
## Key
## 1 14 29
##
##
## Column legend:
## 1:Sample 1
## 2:Sample 2
## 3:Sample 3
## 4:Sample 4
## 5:Sample 5
## 6:Sample 6
## 7:Sample 7
## 8:Sample 8
## 9:Sample 9
## 10:Sample 10
##
##
## 1 2 3 4 5 6 7 8 9 10
## Gene 6
## Gene 17
## Gene 1
## Gene 4
## Gene 14
## Gene 19
## Gene 2
## Gene 15
## Gene 11
## Gene 13
## Gene 3
## Gene 16
## Gene 10
## Gene 5
## Gene 8
## Gene 9
## Gene 12
## Gene 20
## Gene 7
## Gene 18
##
##
## Key
## 1 14 29
##
##
## Column legend:
## 1:Sample 1
## 2:Sample 2
## 3:Sample 3
## 4:Sample 4
## 5:Sample 5
## 6:Sample 6
## 7:Sample 7
## 8:Sample 8
## 9:Sample 9
## 10:Sample 10
##
##
## 1 2 3 4 5 6 7 8 9 10
## Gene 1
## Gene 2
## Gene 3
## Gene 4
## Gene 5
## Gene 6
## Gene 7
## Gene 8
## Gene 9
## Gene 10
## Gene 11
## Gene 12
## Gene 13
## Gene 14
## Gene 15
## Gene 16
## Gene 17
## Gene 18
## Gene 19
## Gene 20
##
##
## Key
## 1 14 29
##
##
## Column legend:
## 1:Sample 1
## 2:Sample 2
## 3:Sample 3
## 4:Sample 4
## 5:Sample 5
## 6:Sample 6
## 7:Sample 7
## 8:Sample 8
## 9:Sample 9
## 10:Sample 10
sessionInfo()## R version 3.5.2 (2018-12-20)
## Platform: x86_64-apple-darwin15.6.0 (64-bit)
## Running under: macOS High Sierra 10.13.1
##
## Matrix products: default
## BLAS: /Library/Frameworks/R.framework/Versions/3.5/Resources/lib/libRblas.0.dylib
## LAPACK: /Library/Frameworks/R.framework/Versions/3.5/Resources/lib/libRlapack.dylib
##
## locale:
## [1] C/UTF-8/C/C/C/C
##
## attached base packages:
## [1] stats graphics grDevices utils datasets methods base
##
## other attached packages:
## [1] pheatmap_1.0.12 crayon_1.3.4
##
## loaded via a namespace (and not attached):
## [1] Rcpp_1.0.1 knitr_1.22 magrittr_1.5
## [4] tidyselect_0.2.5 munsell_0.5.0 viridisLite_0.3.0
## [7] colorspace_1.4-1 R6_2.4.0 rlang_0.3.4
## [10] fansi_0.4.0 dplyr_0.8.0.1 stringr_1.4.0
## [13] plyr_1.8.4 tools_3.5.2 grid_3.5.2
## [16] gtable_0.3.0 xfun_0.6 htmltools_0.3.6
## [19] assertthat_0.2.1 yaml_2.2.0 lazyeval_0.2.2
## [22] digest_0.6.18 tibble_2.1.1 gridExtra_2.3
## [25] purrr_0.3.2 RColorBrewer_1.1-2 ggplot2_3.1.1
## [28] viridis_0.5.1 glue_1.3.1 evaluate_0.13
## [31] rmarkdown_1.12 stringi_1.4.3 compiler_3.5.2
## [34] pillar_1.3.1 scales_1.0.0 pkgconfig_2.0.2Some things still need further improvements:
crayon package
fansi package and his help in getting it to show in markdowns
pheatmap package.