## ----global_settings, echo = FALSE, message = FALSE----------------------
library(markdown)
options(markdown.HTML.options = c(options('markdown.HTML.options')[[1]], "toc"))

library(knitr)
knitr::opts_chunk$set(
    error = FALSE,
    tidy  = FALSE,
    message = FALSE,
    fig.align = "center",
    fig.width = 5,
    fig.height = 5)
options(markdown.HTML.stylesheet = "custom.css")

options(width = 100)


## ----design, echo = FALSE, fig.width = 10, fig.height = 5----------------
source("design.R")


## ----data----------------------------------------------------------------
library(ComplexHeatmap)
library(circlize)
library(colorspace)
library(GetoptLong)

set.seed(123)

mat = cbind(rbind(matrix(rnorm(16, -1), 4), matrix(rnorm(32, 1), 8)),
            rbind(matrix(rnorm(24, 1), 4), matrix(rnorm(48, -1), 8)))

rownames(mat) = paste0("R", 1:12)
colnames(mat) = paste0("C", 1:10)


## ----default-------------------------------------------------------------
Heatmap(mat)


## ----color_fun-----------------------------------------------------------
Heatmap(mat, col = colorRamp2(c(-3, 0, 3), c("green", "white", "red")))


## ----discrete_matrix-----------------------------------------------------
discrete_mat = matrix(sample(1:4, 100, replace = TRUE), 10, 10)
colors = structure(rainbow_hcl(4), names = c("1", "2", "3", "4"))
Heatmap(discrete_mat, col = colors)


## ----discrete_character_matrix-------------------------------------------
discrete_mat = matrix(sample(letters[1:4], 100, replace = TRUE), 10, 10)
colors = structure(rainbow_hcl(4), names = letters[1:4])
Heatmap(discrete_mat, col = colors)


## ----with_matrix_name----------------------------------------------------
Heatmap(mat, name = "foo")


## ----row_column_title----------------------------------------------------
Heatmap(mat, name = "foo", column_title = "I am a column title", 
    row_title = "I am a row title")
Heatmap(mat, name = "foo", column_title = "I am a column title at the bottom", 
    column_title_side = "bottom")
Heatmap(mat, name = "foo", column_title = "I am a big column title", 
    column_title_gp = gpar(fontsize = 20, fontface = "bold"))


## ----cluster_basic-------------------------------------------------------
Heatmap(mat, name = "foo", cluster_rows = FALSE)
Heatmap(mat, name = "foo", show_column_hclust = FALSE)
Heatmap(mat, name = "foo", row_hclust_side = "right")
Heatmap(mat, name = "foo", column_hclust_height = unit(2, "cm"))


## ----cluster_distance----------------------------------------------------
Heatmap(mat, name = "foo", clustering_distance_rows = "pearson")
Heatmap(mat, name = "foo", clustering_distance_rows = function(m) dist(m))
Heatmap(mat, name = "foo", clustering_distance_rows = function(x, y) 1 - cor(x, y))


## ----cluster_distance_advanced-------------------------------------------
mat_with_outliers = mat
for(i in  1:10) mat_with_outliers[i, i] = 1000
robust_dist = function(x, y) {
    qx = quantile(x, c(0.1, 0.9))
    qy = quantile(y, c(0.1, 0.9))
    l = x > qx[1] & x < qx[2] & y > qy[1] & y < qy[2]
    x = x[l]
    y = y[l]
    sqrt(sum((x - y)^2))
}
Heatmap(mat_with_outliers, name = "foo", 
    col = colorRamp2(c(-3, 0, 3), c("green", "white", "red")),
    clustering_distance_rows = robust_dist,
    clustering_distance_columns = robust_dist)



## ----cluster_method------------------------------------------------------
Heatmap(mat, name = "foo", clustering_method_rows = "single")


## ----cluster_object------------------------------------------------------
library(cluster)
Heatmap(mat, name = "foo", cluster_rows = as.dendrogram(diana(mat)),
   cluster_columns = as.dendrogram(agnes(t(mat))))


## ----cluster_dendextend--------------------------------------------------
library(dendextend)
dend = hclust(dist(mat))
dend = color_branches(dend, k = 2)
Heatmap(mat, name = "foo", cluster_rows = dend)


## ----cluster_function----------------------------------------------------
Heatmap(mat, name = "foo", cluster_rows = function(m) hclust(dist(m)),
    cluster_columns = function(m) hclust(dist(m)))


## ----dimension_name------------------------------------------------------
Heatmap(mat, name = "foo", row_names_side = "left", row_hclust_side = "right", 
    column_names_side = "top", column_hclust_side = "bottom")
Heatmap(mat, name = "foo", show_row_names = FALSE)
Heatmap(mat, name = "foo", row_names_gp = gpar(fontsize = 20))
Heatmap(mat, name = "foo", row_names_gp = gpar(col = c(rep("red", 4), rep("blue", 8))))


## ----k_means-------------------------------------------------------------
Heatmap(mat, name = "foo", km = 2)


## ----split---------------------------------------------------------------
Heatmap(mat, name = "foo", split = rep(c("A", "B"), 6))
Heatmap(mat, name = "foo", split = data.frame(rep(c("A", "B"), 6), rep(c("C", "D"), each = 6)))
Heatmap(mat, name = "foo", split = data.frame(rep(c("A", "B"), 6), rep(c("C", "D"), each = 6)), 
    combined_name_fun = function(x) paste(x, collapse = "\n"))
Heatmap(mat, name = "foo", km = 2, split = rep(c("A", "B"), 6), 
    combined_name_fun = function(x) paste(x, collapse = "\n"))
Heatmap(mat, name = "foo", km = 2, split = rep(c("A", "B"), 6), combined_name_fun = NULL)


## ----pam-----------------------------------------------------------------
pa = pam(mat, k = 3)
Heatmap(mat, name = "foo", split = paste0("pam", pa$clustering))


## ----split_gap-----------------------------------------------------------
Heatmap(mat, name = "foo", split = paste0("pam", pa$clustering), gap = unit(5, "mm"))


## ----split_discrete_matrix-----------------------------------------------
Heatmap(discrete_mat, name = "foo", split = rep(letters[1:2], each = 5))


## ----cell_fun------------------------------------------------------------
mat2 = matrix(sample(1:10, 12, replace = TRUE), 4, 3)

ht = Heatmap(mat2, rect_gp = gpar(col = "white", lwd = 2, type = "none"), 
    cell_fun = function(j, i, x, y, width, height, fill) {
        grid.roundrect(x, y, width*0.8, height*0.8, gp = gpar(fill = fill))
        if(mat2[i, j] <= 4) {
            grid.text("cold", x = x, y = y)
        } else if(mat2[i, j] >= 7) {
            grid.text("hot", x = x, y = y)
        } else {
            grid.text("normal", x = x, y = y)
        }
    },
    cluster_rows = FALSE, cluster_columns = FALSE)
draw(ht, show_heatmap_legend = FALSE)


## ----heatmap_annotation, fig.width = 7, fig.height = 0.5-----------------
df = data.frame(type = c(rep("a", 5), rep("b", 5)))
ha = HeatmapAnnotation(df = df)
ha
draw(ha, 1:10)


## ----heatmap_annotation_col, fig.width = 7, fig.height = 0.5-------------
ha = HeatmapAnnotation(df = df, col = list(type = c("a" =  "red", "b" = "blue")))
ha
draw(ha, 1:10)


## ----heatmap_annotation_colfun, fig.width = 7, fig.height = 0.5----------
ha = HeatmapAnnotation(df = data.frame(age = sample(1:20, 10)),
    col = list(age = colorRamp2(c(0, 20), c("white", "red"))))
ha
draw(ha, 1:10)


## ----heatmap_annotation_mixed, fig.width = 7, fig.height = 1-------------
ha = HeatmapAnnotation(df = data.frame(type = c(rep("a", 5), rep("b", 5)),
                                       age = sample(1:20, 10)),
    col = list(type = c("a" = "red", "b" = "blue"),
               age = colorRamp2(c(0, 20), c("white", "red")))
)
ha
draw(ha, 1:10)


## ----heatmap_annotation_complex, fig.width = 7, fig.height = 1-----------
value = rnorm(10)
column_anno = function(index) {
    n = length(index)
    pushViewport(viewport(xscale = c(0.5, n + 0.5), yscale = range(value)))
    grid.points(index, value, pch = 16)
    upViewport() # this is very important in order not to mess up the layout
}
ha = HeatmapAnnotation(points = column_anno)
ha
draw(ha, 1:10)


## ----heatmap_annotation_points, fig.width = 7, fig.height = 1------------
ha = HeatmapAnnotation(points = anno_points(value))
draw(ha, 1:10)


## ----heatmap_annotation_barplot, fig.width = 7, fig.height = 1-----------
ha = HeatmapAnnotation(points = anno_barplot(value))
draw(ha, 1:10)


## ----heatmap_annotation_boxplot, fig.width = 7, fig.height = 1-----------
ha = HeatmapAnnotation(boxplot = anno_boxplot(mat))
draw(ha, 1:10)


## ----heatmap_annotation_mixed_with_complex, fig.width = 7, fig.height = 2----
ha = HeatmapAnnotation(df = df, points = anno_points(value))
ha
draw(ha, 1:10)


## ----, fig.width = 7, fig.height = 3-------------------------------------
ha = HeatmapAnnotation(df = df, points = anno_points(value), boxplot = anno_boxplot(mat),
    annotation_height = c(1, 2, 3))
draw(ha, 1:10)


## ----, fig.width = 7, fig.height = 3-------------------------------------
ha = HeatmapAnnotation(df = df, points = anno_points(value), boxplot = anno_boxplot(mat),
    annotation_height = unit.c(unit(1, "null"), unit(3, "cm"), unit(3, "cm")))
draw(ha, 1:10)


## ----add_annotation------------------------------------------------------
ha = HeatmapAnnotation(df = df, points = anno_points(value))
ha_boxplot = HeatmapAnnotation(boxplot = anno_boxplot(mat))
Heatmap(mat, name = "foo", top_annotation = ha, bottom_annotation = ha_boxplot, 
    bottom_annotation_height = unit(2, "cm"))


## ----annotation_show-----------------------------------------------------
ha = HeatmapAnnotation(df = df, show_legend = FALSE)
Heatmap(mat, name = "foo", top_annotation = ha)


## ----annotation_more, fig.height = 10, fig.width = 10--------------------
ha_mix_top = HeatmapAnnotation(histogram = anno_histogram(mat, gp = gpar(fill = rep(2:3, each = 5))),
    density_line = anno_density(mat, type = "line", gp = gpar(col = rep(2:3, each = 5))),
    violin = anno_density(mat, type = "violin", gp = gpar(fill = rep(2:3, each = 5))),
    heatmap = anno_density(mat, type = "heatmap"))
ha_mix_right = HeatmapAnnotation(histogram = anno_histogram(mat, gp = gpar(fill = rep(2:3, each = 5)), which = "row"),
    density_line = anno_density(mat, type = "line", gp = gpar(col = rep(2:3, each = 5)), which = "row"),
    violin = anno_density(mat, type = "violin", gp = gpar(fill = rep(2:3, each = 5)), which = "row"),
    heatmap = anno_density(mat, type = "heatmap", which = "row"), 
    which = "row", width = unit(8, "cm"))
Heatmap(mat, name = "foo", top_annotation = ha_mix_top, top_annotation_height = unit(8, "cm")) + ha_mix_right


## ----heatmap_list_default, fig.width = 10--------------------------------
mat = matrix(rnorm(80, 2), 8, 10)
mat = rbind(mat, matrix(rnorm(40, -2), 4, 10))
rownames(mat) = paste0("R", 1:12)
colnames(mat) = paste0("C", 1:10)

ht1 = Heatmap(mat, name = "ht1")
ht2 = Heatmap(mat, name = "ht2")
class(ht1)
class(ht2)

ht1 + ht2


## ------------------------------------------------------------------------
ht_list = ht1 + ht2
class(ht_list)


## ----, eval = FALSE------------------------------------------------------
## ht1 + ht1 + ht1
## ht1 + ht_list
## ht_list + ht1
## ht_list + ht_list


## ----heatmap_list_title, fig.width = 10----------------------------------
ht1 = Heatmap(mat, name = "ht1", row_title = "Heatmap 1", column_title = "Heatmap 1")
ht2 = Heatmap(mat, name = "ht2", row_title = "Heatmap 2", column_title = "Heatmap 2")
ht_list = ht1 + ht2

draw(ht_list, row_title = "Two heatmaps, row title", row_title_gp = gpar(col = "red"),
    column_title = "Two heatmaps, column title", column_title_side = "bottom")


## ----legend, fig.width = 10, fig.keep = "all"----------------------------
df = data.frame(type = c(rep("a", 5), rep("b", 5)))
ha = HeatmapAnnotation(df = df, col = list(type = c("a" =  "red", "b" = "blue")))

ht1 = Heatmap(mat, name = "ht1", column_title = "Heatmap 1", top_annotation = ha)
ht2 = Heatmap(mat, name = "ht2", column_title = "Heatmap 2")
ht_list = ht1 + ht2

draw(ht_list)
draw(ht_list, heatmap_legend_side = "left", annotation_legend_side = "bottom")
draw(ht_list, show_heatmap_legend = FALSE, show_annotation_legend = FALSE)


## ----legend_show, fig.width = 10-----------------------------------------
ht1 = Heatmap(mat, name = "ht1", column_title = "Heatmap 1", top_annotation = ha)
ht2 = Heatmap(mat, name = "ht2", column_title = "Heatmap 2", show_heatmap_legend = FALSE)
ht1 + ht2


## ----self_defined_legend, fig.width = 10---------------------------------
ha = HeatmapAnnotation(points = anno_points(rnorm(10)))
ht2 = Heatmap(mat, name = "ht2", column_title = "Heatmap 2", top_annotation = ha, show_heatmap_legend = FALSE)
lgd = legendGrob(c("dots"), pch = 16)
draw(ht1 + ht2, annotation_legend_list = list(lgd))


## ----heatmap_list_advanced, fig.width = 10-------------------------------
draw(ht1 + ht2, legend_grid_width = unit(6, "mm"), 
    legend_title_gp = gpar(fontsize = 14, fontface = "bold"))


## ----heatmap_list_gap, fig.width = 10, fig.keep = "all"------------------
draw(ht_list, gap = unit(1, "cm"))
draw(ht_list + ht_list, gap = unit(c(3, 6, 9, 0), "mm"))


## ----heatmap_list_size, fig.width = 10, fig.keep = "all"-----------------
ht1 = Heatmap(mat, name = "ht1", column_title = "Heatmap 1")
ht2 = Heatmap(mat, name = "ht2", column_title = "Heatmap 2", width = unit(5, "cm"))
ht1 + ht2


## ----heatmap_list_auto_adjust, fig.width = 10, fig.keep = "all"----------
ht1 = Heatmap(mat, name = "ht1", column_title = "Heatmap 1", km = 2)
ht2 = Heatmap(mat, name = "ht2", column_title = "Heatmap 2")
ht1 + ht2

draw(ht2 + ht1)
draw(ht2 + ht1, main_heatmap = "ht1")


## ----heatmap_list_auto_adjust_no_row_cluster, fig.width = 10-------------
ht1 = Heatmap(mat, name = "ht1", column_title = "Heatmap 1", cluster_rows = FALSE)
ht2 = Heatmap(mat, name = "ht2", column_title = "Heatmap 2")
ht1 + ht2


## ----row_annotation, fig.width = 1, fig.height = 7-----------------------
df = data.frame(type = c(rep("a", 6), rep("b", 6)))
ha = HeatmapAnnotation(df = df, which = "row", width = unit(1, "cm"))
draw(ha, 1:12)


## ----heatmap_list_with_row_annotation, fig.width = 9---------------------
ht1 = Heatmap(mat, name = "ht1")
ht1 + ha + ht1


## ----heatmap_list_with_row_annotation_complex----------------------------
ht1 = Heatmap(mat, name = "ht1", km = 2)
ha_boxplot = HeatmapAnnotation(boxplot = anno_boxplot(mat, which = "row"), 
    which = "row", width = unit(2, "cm"))
draw(ha_boxplot + ht1, row_hclust_side = "left", row_sub_title_side = "right")


## ----complex_heatmap, fig.width = 7--------------------------------------
ht1 = Heatmap(mat, name = "ht1", km = 2)
random_data = lapply(1:12, function(x) runif(20))
random_data[1:6] = lapply(random_data[1:6], function(x) x*0.5)
ha = HeatmapAnnotation(distribution = function(index) {
        random_data = random_data[index]
        n = length(index)
        
        for(i in seq_len(n)) {
            y = random_data[[i]]
            pushViewport(viewport(x= 0, y = (i-0.5)/n, width = unit(1, "npc") - unit(1, "cm"), 
                height = 1/n*0.8, just = "left", xscale = c(0, 20), yscale = c(0, 1)))
            if(index[i] %in% 1:6) fill = "blue" else fill = "red"
            grid.polygon(c(1:20, 20, 1), c(y, 0, 0), default.units = "native", 
                gp = gpar(fill = fill, col = NA))
            grid.yaxis(main = FALSE, gp = gpar(fontsize = 8))
            upViewport()
        }
    }, which = "row", width = unit(10, "cm"))
draw(ht1 + ha, row_hclust_side = "left", row_sub_title_side = "right")


## ----access_components, fig.width = 10, fig.height = 7-------------------
ha_column1 = HeatmapAnnotation(points = anno_points(rnorm(10)))
ht1 = Heatmap(mat, name = "ht1", km = 2, row_title = "Heatmap 1", column_title = "Heatmap 1", 
    top_annotation = ha_column1)

ha_column2 = HeatmapAnnotation(df = data.frame(type = c(rep("a", 5), rep("b", 5))))
ht2 = Heatmap(mat, name = "ht2", row_title = "Heatmap 2", column_title = "Heatmap 2",
    bottom_annotation = ha_column2)

ht_list = ht1 + ht2
draw(ht_list, row_title = "Heatmap list", column_title = "Heatmap list", 
    heatmap_legend_side = "right", annotation_legend_side = "left")


## ----, fig.width = 10, fig.height = 7------------------------------------
ht_list

seekViewport("annotation_points")
grid.text("points", unit(0, "npc") - unit(2, "mm"), 0.5, default.units = "npc", just = "right")

seekViewport("ht1_heatmap_body_2")
grid.text("outlier", 1.5/10, 2.5/4, default.units = "npc")

seekViewport("annotation_type")
grid.text("type", unit(1, "npc") + unit(2, "mm"), 0.5, default.units = "npc", just = "left")


## ----expression_example, fig.width = 10, fig.height = 8------------------
expr = readRDS(paste0(system.file(package = "ComplexHeatmap"), "/extdata/gene_expression.rds"))
mat = as.matrix(expr[, grep("cell", colnames(expr))])

type = gsub("s\\d+_", "", colnames(mat))
ha = HeatmapAnnotation(df = data.frame(type = type))

Heatmap(mat, name = "expression", km = 5, top_annotation = ha, 
    top_annotation_height = unit(4, "mm"), show_row_names = FALSE, 
    show_column_names = FALSE) +
Heatmap(expr$length, name = "length", col = colorRamp2(c(0, 100000), c("white", "orange")),
    width = unit(5, "mm")) +
Heatmap(expr$type, name = "type", width = unit(5, "mm")) +
Heatmap(expr$chr, name = "chr", col = rand_color(length(unique(expr$chr))), 
    width = unit(5, "mm"))


## ----, echo = FALSE, fig.width = 10, fig.height = 8----------------------
source("oncoprint.R")


## ----, echo = FALSE, fig.width = 10, fig.height = 8----------------------
source("genomic_regions.R")


## ------------------------------------------------------------------------
sessionInfo()