---
title: "Enhanced Heat Maps with heatmap.2"
date: "`r Sys.Date()`"
author: "Andy Liaw, original; R. Gentleman, M. Maechler, W. Huber, G. Warnes, revisions. Tal Galili"
output: 
  html_vignette: 
    toc: yes
    code_folding: show
editor_options: 
  chunk_output_type: console
---
<!--
  %\VignetteIndexEntry{Enhanced Heat Maps with heatmap.2}
  %\VignetteEngine{knitr::rmarkdown}
  %\VignetteEncoding{UTF-8}
-->


```{r setup, include=FALSE}
knitr::opts_chunk$set(
  echo = TRUE,
  warning = FALSE,
  message = FALSE,
  fig.width = 8,
  fig.height = 6,
  fig.align = "center"
)
```

# Introduction

The `heatmap.2` function provides an enhanced version of the standard R `heatmap` function with numerous additional features and customization options. This vignette demonstrates the key capabilities and usage patterns of `heatmap.2`. It is based on the manual for `?heatmap.2`, written by Andy Liaw, original; R. Gentleman, M. Maechler, W. Huber, G. Warnes, revisions.


# Details on Dendrograms, Scaling, and Plot Layout

### Dendrogram Behavior (`Rowv`, `Colv`)

* If either **`Rowv`** or **`Colv`** are already **dendrograms**, they are **honored** and their ordering is preserved (not reordered).
* Otherwise, dendrograms are computed as $dd \leftarrow \text{as.dendrogram}(\text{hclustfun}(\text{distfun}(X)))$, where $X$ is either $x$ or $t(x)$.
* If either is a **vector** (of "weights"), the appropriate dendrogram ($dd$) is **reordered** according to the supplied values, subject to the constraints imposed by the dendrogram, using $\texttt{reorder}(dd, Rowv)$ (in the row case).
* If either is **missing** (as by default), the ordering of the corresponding dendrogram is by the **mean value** of the rows/columns (e.g., $Rowv \leftarrow \text{rowMeans}(x, \text{na.rm=na.rm})$ in the row case).
* If either is **`NULL`**, **no reordering** will be done for the corresponding side.


### Data Scaling (`scale`)

* If **`scale="row"`** (or **`scale="col"`**), the rows (columns) are scaled to have **mean zero** and **standard deviation one**.
* This scaling has some empirical evidence of being useful in genomic plotting.

### Color Selection

* The **default colors** range from red to white ($\texttt{heat.colors}$) and are generally not considered aesthetically pleasing.
* Consider using enhancements like the **RColorBrewer** package to select better colors.

### Plot Layout (Default and Customization)

* By default, **four components** are displayed in the plot:
    * **Top left:** The **color key**.
    * **Top right:** The **column dendrogram**.
    * **Bottom left:** The **row dendrogram**.
    * **Bottom right:** The **image plot** (heatmap).
* When **`RowSideColor`** or **`ColSideColor`** are provided, an **additional row or column** is inserted in the appropriate location.
* This layout can be overridden by specifying appropriate values for **`lmat`**, **`lwid`**, and **`lhei`**:
    * **`lmat`** controls the **relative position** of each element.
    * **`lwid`** controls the **column width**.
    * **`lhei`** controls the **row height**.
* See the help page for **`layout`** for details on how to use these arguments.

## Note

* The original rows and columns are **reordered** to match the dendrograms **`Rowv`** and **`Colv`** (if present).
* **`heatmap.2()`** uses **`layout`** to arrange the plot elements. Consequentially, it **cannot** be used in a multi-column/row layout using **`layout(...)`**, **`par(mfrow=...)`** or **`(mfcol=...)`**.

# Load Data

```{r load-libraries}
# Load required libraries
library(gplots)  # for heatmap.2
library(RColorBrewer)  # for better color palettes
```

```{r}
data(mtcars)
x  <- as.matrix(mtcars)
rc <- rainbow(nrow(x), start=0, end=.3)
cc <- rainbow(ncol(x), start=0, end=.3)

```

# Dendrogram Options

## demonstrate the effect of row and column dendrogram options

```{r}
heatmap.2(x)                    ## default - dendrogram plotted and reordering done.
heatmap.2(x, dendrogram="none") ##  no dendrogram plotted, but reordering done.
heatmap.2(x, dendrogram="row")  ## row dendrogram plotted and row reordering done.
heatmap.2(x, dendrogram="col")  ## col dendrogram plotted and col reordering done.

heatmap.2(x, keysize=2)         ## default - dendrogram plotted and reordering done.

heatmap.2(x, Rowv=FALSE, dendrogram="both") ## generates a warning!
heatmap.2(x, Rowv=NULL, dendrogram="both")  ## generates a warning!
heatmap.2(x, Colv=FALSE, dendrogram="both") ## generates a warning!

```


## Reorder dendrogram by branch means rather than sums
```{r}
heatmap.2(x, reorderfun=function(d, w) reorder(d, w, agglo.FUN = mean) )

```


## Color dendrograms' branches (using dendextend)

```{r, fig.keep='none'}
full <- heatmap.2(x) # we use it to easily get the dendrograms
```


```{r}
library(dendextend)  # for color_branches
heatmap.2(x, 
        Rowv=color_branches(full$rowDendrogram, k = 3),
        Colv=color_branches(full$colDendrogram, k = 2))
# Look at the vignette for more details:
# https://cran.r-project.org/web/packages/dendextend/vignettes/dendextend.html

```


## plot a sub-cluster using the same color coding as for the full heatmap
```{r}
full <- heatmap.2(x)
heatmap.2(x, Colv=full$colDendrogram[[2]], breaks=full$breaks)  # column subset
heatmap.2(x, Rowv=full$rowDendrogram[[1]], breaks=full$breaks)  # row subset
heatmap.2(x, Colv=full$colDendrogram[[2]],
            Rowv=full$rowDendrogram[[1]], breaks=full$breaks)  # both


```


# Show effect of row and column label rotation
```{r}

heatmap.2(x, srtCol=NULL)
heatmap.2(x, srtCol=0,   adjCol = c(0.5,1) )
heatmap.2(x, srtCol=45,  adjCol = c(1,1)   )
heatmap.2(x, srtCol=135, adjCol = c(1,0)   )
heatmap.2(x, srtCol=180, adjCol = c(0.5,0) )
heatmap.2(x, srtCol=225, adjCol = c(0,0)   ) ## not very useful
heatmap.2(x, srtCol=270, adjCol = c(0,0.5) )
heatmap.2(x, srtCol=315, adjCol = c(0,1)   )
heatmap.2(x, srtCol=360, adjCol = c(0.5,1) )

heatmap.2(x, srtRow=45, adjRow=c(0, 1) )
heatmap.2(x, srtRow=45, adjRow=c(0, 1), srtCol=45, adjCol=c(1,1) )
heatmap.2(x, srtRow=45, adjRow=c(0, 1), srtCol=270, adjCol=c(0,0.5) )

```

# Show effect of offsetRow/offsetCol (only works when srtRow/srtCol is
```{r}
## not also present)
heatmap.2(x, offsetRow=0, offsetCol=0)
heatmap.2(x, offsetRow=1, offsetCol=1)
heatmap.2(x, offsetRow=2, offsetCol=2)
heatmap.2(x, offsetRow=-1, offsetCol=-1)

heatmap.2(x, srtRow=0, srtCol=90, offsetRow=0, offsetCol=0)
heatmap.2(x, srtRow=0, srtCol=90, offsetRow=1, offsetCol=1)
heatmap.2(x, srtRow=0, srtCol=90, offsetRow=2, offsetCol=2)
heatmap.2(x, srtRow=0, srtCol=90, offsetRow=-1, offsetCol=-1)

```

# Show how to use 'extrafun' to replace the 'key' with a scatterplot
```{r}
lmat <- rbind( c(5,3,4), c(2,1,4) )
lhei <- c(1.5, 4)
lwid <- c(1.5, 4, 0.75)

myplot <- function() {
           oldpar <- par("mar")
           par(mar=c(5.1, 4.1, 0.5, 0.5))
           plot(mpg ~ hp, data=x)
         }

heatmap.2(x, lmat=lmat, lhei=lhei, lwid=lwid, key=FALSE, extrafun=myplot)

```

# show how to customize the color key
```{r}

heatmap.2(x,
         key.title=NA, # no title
         key.xlab=NA,  # no xlab
         key.par=list(mgp=c(1.5, 0.5, 0),
                      mar=c(2.5, 2.5, 1, 0)),
         key.xtickfun=function() {
               breaks <- parent.frame()$breaks
               return(list(
                    at=parent.frame()$scale01(c(breaks[1],
                                                breaks[length(breaks)])),
                    labels=c(as.character(breaks[1]),
                             as.character(breaks[length(breaks)]))
                    ))
         })

heatmap.2(x,
        breaks=256,
        key.title=NA,
        key.xlab=NA,
        key.par=list(mgp=c(1.5, 0.5, 0),
                     mar=c(1, 2.5, 1, 0)),
        key.xtickfun=function() {
             cex <- par("cex")*par("cex.axis")
             side <- 1
             line <- 0
             col <- par("col.axis")
             font <- par("font.axis")
             mtext("low", side=side, at=0, adj=0,
                   line=line, cex=cex, col=col, font=font)
             mtext("high", side=side, at=1, adj=1,
                   line=line, cex=cex, col=col, font=font)
             return(list(labels=FALSE, tick=FALSE))
        })


```

# Show effect of z-score scaling within columns, blue-red color scale
```{r}
##
##
hv <- heatmap.2(x, col=bluered, scale="column", tracecol="#303030")

###
## Look at the return values
###
names(hv)

## Show the mapping of z-score values to color bins
hv$colorTable

## Extract the range associated with white
hv$colorTable[hv$colorTable[,"color"]=="#FFFFFF",]

## Determine the original data values that map to white
whiteBin <- unlist(hv$colorTable[hv$colorTable[,"color"]=="#FFFFFF",1:2])
rbind(whiteBin[1] * hv$colSDs + hv$colMeans,
     whiteBin[2] * hv$colSDs + hv$colMeans )
##
## A more decorative heatmap, with z-score scaling along columns
##
hv <- heatmap.2(x, col=cm.colors(255), scale="column",
       RowSideColors=rc, ColSideColors=cc, margin=c(5, 10),
       xlab="specification variables", ylab= "Car Models",
       main="heatmap(<Mtcars data>, ..., scale=\"column\")",
       tracecol="green", density="density")
## Note that the breakpoints are now symmetric about 0

## Color the labels to match RowSideColors and ColSideColors
hv <- heatmap.2(x, col=cm.colors(255), scale="column",
       RowSideColors=rc, ColSideColors=cc, margin=c(5, 10),
       xlab="specification variables", ylab= "Car Models",
       main="heatmap(<Mtcars data>, ..., scale=\"column\")",
       tracecol="green", density="density", colRow=rc, colCol=cc,
       srtCol=45, adjCol=c(0.5,1))



```


# Correlation Heatmaps
```{r}
# TODO: want example using the `add.exp' argument!

data(attitude)
round(Ca <- cor(attitude), 2)
symnum(Ca) # simple graphic

# with reorder
heatmap.2(Ca, 		 symm=TRUE, margin=c(6, 6), trace="none" )

# without reorder
heatmap.2(Ca, Rowv=FALSE, symm=TRUE, margin=c(6, 6), trace="none" )

## Place the color key below the image plot
heatmap.2(x, lmat=rbind( c(0, 3), c(2,1), c(0,4) ), lhei=c(1.5, 4, 2 ) )

## Place the color key to the top right of the image plot
heatmap.2(x, lmat=rbind( c(0, 3, 4), c(2,1,0 ) ), lwid=c(1.5, 4, 2 ) )

```



## For variable clustering, rather use distance based on cor():
```{r}
data(USJudgeRatings)
symnum( cU <- cor(USJudgeRatings) )

hU <- heatmap.2(cU, Rowv=FALSE, symm=TRUE, col=topo.colors(16),
            distfun=function(c) as.dist(1 - c), trace="none")

## The Correlation matrix with same reordering:
hM <- format(round(cU, 2))
hM

```


now with the correlation matrix on the plot itself
```{r}

heatmap.2(cU, Rowv=FALSE, symm=TRUE, col=rev(heat.colors(16)),
           distfun=function(c) as.dist(1 - c), trace="none",
           cellnote=hM)

```


# Interactive heatmap.2 using heatmaply
```{r}
data(mtcars)
x  <- as.matrix(mtcars)

library(heatmaply)
# just use heatmaply instead of heatmap.2
heatmaply(x)

```


The default are slightly different, but it supports most of the same arguments.
If you want the dendrograms to match perfectly, use this:

```{r, fig.keep='none'}
full <- heatmap.2(x) # we use it to easily get the dendrograms
```


```{r}
## Color branches of dendrograms by cluster membership using dendextend:
heatmaply(x, 
        Rowv=color_branches(full$rowDendrogram, k = 3),
        Colv=color_branches(full$colDendrogram, k = 2))
# Look at the vignette for more details:
# https://cran.r-project.org/web/packages/heatmaply/vignettes/heatmaply.html

```



# Session Information

```{r session-info}
sessionInfo()
```

# References

- Original `heatmap` function: R Core Team
- `heatmap.2` enhancements: Andy Liaw, R. Gentleman, M. Maechler, W. Huber, G. Warnes
- `gplots` package documentation
- RColorBrewer package for color palettes