## ----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)

## ----access_components, fig.width = 10, fig.height = 7, echo = 1:13-------------------------------
library(ComplexHeatmap)

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)

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))),
    col = list(type = c("a" = "red", "b" = "blue")))
ht2 = Heatmap(mat, name = "ht2", row_title = "Heatmap 2", column_title = "Heatmap 2",
    bottom_annotation = ha_column2)

ht_list = ht1 + ht2 + rowAnnotation(bar = row_anno_barplot(rowMeans(mat)))
draw(ht_list, row_title = "Heatmap list", column_title = "Heatmap list", 
    heatmap_legend_side = "right", annotation_legend_side = "left")

library(GetoptLong)
seekViewport("global"); grid.rect(gp = gpar(fill = NA, col = "red"))
seekViewport("global_column_title"); grid.rect(gp = gpar(fill = NA, col = "red"))
seekViewport("global_row_title"); grid.rect(gp = gpar(fill = NA, col = "red"))
seekViewport("main_heatmap_list"); grid.rect(gp = gpar(fill = NA, col = "red"))
for(heatmap_name in c("ht1", "ht2")) {
    seekViewport(qq("heatmap_@{heatmap_name}")); grid.rect(gp = gpar(fill = NA, col = "red"))
    for(i in 1:2) {
        seekViewport(qq("@{heatmap_name}_heatmap_body_@{i}")); grid.rect(gp = gpar(fill = NA, col = "red"))
        seekViewport(qq("@{heatmap_name}_row_names_@{i}")); grid.rect(gp = gpar(fill = NA, col = "red"))
    }
        
    seekViewport(qq("@{heatmap_name}_column_title")); grid.rect(gp = gpar(fill = NA, col = "red"))
    seekViewport(qq("@{heatmap_name}_dend_column")); grid.rect(gp = gpar(fill = NA, col = "red"))
    seekViewport(qq("@{heatmap_name}_column_names")); grid.rect(gp = gpar(fill = NA, col = "red"))
    seekViewport(qq("legend_@{heatmap_name}")); grid.rect(gp = gpar(fill = NA, col = "red"))
}
seekViewport(qq("ht1_dend_row_2")); grid.rect(gp = gpar(fill = NA, col = "red"))
seekViewport(qq("ht1_dend_row_1")); grid.rect(gp = gpar(fill = NA, col = "red"))
seekViewport(qq("ht1_row_title_1")); grid.rect(gp = gpar(fill = NA, col = "red"))
seekViewport(qq("ht1_row_title_2")); grid.rect(gp = gpar(fill = NA, col = "red"))


for(annotation_name in c("points", "type")) {
    seekViewport(qq("annotation_@{annotation_name}")); grid.rect(gp = gpar(fill = NA, col = "red"))
}
seekViewport(qq("annotation_bar_1")); grid.rect(gp = gpar(fill = NA, col = "red"))
seekViewport(qq("annotation_bar_2")); grid.rect(gp = gpar(fill = NA, col = "red"))

seekViewport(qq("legend_type")); grid.rect(gp = gpar(fill = NA, col = "red"))
seekViewport(qq("legend_ht1")); grid.rect(gp = gpar(fill = NA, col = "red"))
seekViewport(qq("legend_ht2")); grid.rect(gp = gpar(fill = NA, col = "red"))

seekViewport("heatmap_legend"); grid.rect(gp = gpar(fill = NA, col = "red"))
seekViewport("annotation_legend"); grid.rect(gp = gpar(fill = NA, col = "red"))

## ----components, fig.width = 10, fig.height = 7---------------------------------------------------
ht_list = draw(ht_list, row_title = "Heatmap list", column_title = "Heatmap list", 
    heatmap_legend_side = "right", annotation_legend_side = "left")
decorate_annotation("points", {
    grid.text("points", unit(0, "npc") - unit(2, "mm"), 0.5, 
        default.units = "npc", just = "right")
})

decorate_heatmap_body("ht1", {
    grid.text("outlier", 1.5/10, 2.5/4, default.units = "npc")
    grid.lines(c(0.5, 0.5), c(0, 1), gp = gpar(lty = 2, lwd = 2))
}, slice = 2)

decorate_column_dend("ht1", {
    tree = column_dend(ht_list)$ht1
    ind = cutree(as.hclust(tree), k = 2)[order.dendrogram(tree)]

    first_index = function(l) which(l)[1]
    last_index = function(l) { x = which(l); x[length(x)] }
    x1 = c(first_index(ind == 1), first_index(ind == 2)) - 1
    x2 = c(last_index(ind == 1), last_index(ind == 2))
    grid.rect(x = x1/length(ind), width = (x2 - x1)/length(ind), just = "left",
        default.units = "npc", gp = gpar(fill = c("#FF000040", "#00FF0040"), col = NA))
})

decorate_row_names("ht2", {
    grid.rect(gp = gpar(fill = "#FF000040"))
}, slice = 2)

decorate_row_title("ht1", {
    grid.rect(gp = gpar(fill = "#00FF0040"))
}, slice = 1)

decorate_annotation("points", {
    grid.lines(c(0, 1), unit(c(0, 0), "native"), gp = gpar(col = "red"))
})

## ----annotation_title-----------------------------------------------------------------------------
df = data.frame(type1 = c(rep("a", 5), rep("b", 5)),
                type2 = c(rep("A", 3), rep("B", 7)))
ha = HeatmapAnnotation(df, col = list(type1 = c("a" = "red", "b" = "blue"),
                                      type2 = c("A" = "green", "B" = "orange")))
Heatmap(mat, name = "ht", top_annotation = ha)
for(an in colnames(df)) {
    decorate_annotation(an, {
        # annotation names on the right
        grid.text(an, unit(1, "npc") + unit(2, "mm"), 0.5, default.units = "npc", just = "left")
        # annotation names on the left
        grid.text(an, unit(0, "npc") - unit(2, "mm"), 0.5, default.units = "npc", just = "right")
    })
}

## ---- density-------------------------------------------------------------------------------------
matrix = matrix(rnorm(100), 10); colnames(matrix) = letters[1:10]
ha = HeatmapAnnotation(df = data.frame(anno = rep(c("A", "B"), each = 5)),
    col = list(anno = c("A" = "green", "B" = "orange")),
    points = anno_points(runif(10)))
densityHeatmap(matrix, anno = ha)

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

