## ----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) ## ----data----------------------------------------------------------------------------------------- library(ComplexHeatmap) library(circlize) 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))) # permute the rows and columns mat = mat[sample(nrow(mat), nrow(mat)), sample(ncol(mat), ncol(mat))] rownames(mat) = paste0("R", 1:12) colnames(mat) = paste0("C", 1:10) ## ----default-------------------------------------------------------------------------------------- Heatmap(mat) ## ----color_fun------------------------------------------------------------------------------------ mat2 = mat mat2[1, 1] = 100000 Heatmap(mat2, col = colorRamp2(c(-3, 0, 3), c("green", "white", "red")), cluster_rows = FALSE, cluster_columns = FALSE) ## ----color_vector--------------------------------------------------------------------------------- Heatmap(mat, col = rev(rainbow(10))) ## ----discrete_matrix------------------------------------------------------------------------------ discrete_mat = matrix(sample(1:4, 100, replace = TRUE), 10, 10) colors = structure(circlize::rand_color(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(circlize::rand_color(4), names = letters[1:4]) Heatmap(discrete_mat, col = colors) ## ----na_value------------------------------------------------------------------------------------- mat_with_na = mat mat_with_na[sample(c(TRUE, FALSE), nrow(mat)*ncol(mat), replace = TRUE, prob = c(1, 9))] = NA Heatmap(mat_with_na, na_col = "orange", clustering_distance_rows = "pearson") ## ---- fig.width = 10------------------------------------------------------------------------------ f1 = colorRamp2(seq(min(mat), max(mat), length = 3), c("blue", "#EEEEEE", "red")) f2 = colorRamp2(seq(min(mat), max(mat), length = 3), c("blue", "#EEEEEE", "red"), space = "RGB") Heatmap(mat, col = f1, column_title = "LAB color space") + Heatmap(mat, col = f2, column_title = "RGB color space") ## ---- fig.width = 14, fig.height = 14/5, echo = FALSE, message = FALSE---------------------------- suppressPackageStartupMessages(library(HilbertCurve)) suppressPackageStartupMessages(library(IRanges)) space = c("RGB", "LAB", "XYZ", "sRGB", "LUV") pushViewport(viewport(layout = grid.layout(nr = 1, nc = length(space)))) for(i in seq_along(space)) { pushViewport(viewport(layout.pos.row = 1, layout.pos.col = i)) hc = HilbertCurve(1, 100, level = 4, newpage = FALSE, title = space[i]) ir = IRanges(start = 1:99, end = 2:100) f = colorRamp2(c(-1, 0, 1), c("green", "black", "red"), space = space[i]) col = f(seq(-1, 1, length = 100)) hc_points(hc, ir, np = 3, gp = gpar(col = col, fill = col)) upViewport() } upViewport() grid.newpage() pushViewport(viewport(layout = grid.layout(nr = 1, nc = length(space)))) for(i in seq_along(space)) { pushViewport(viewport(layout.pos.row = 1, layout.pos.col = i)) hc = HilbertCurve(1, 100, level = 4, newpage = FALSE, title = space[i]) ir = IRanges(start = 1:99, end = 2:100) f = colorRamp2(c(-1, 0, 1), c("blue", "white", "red"), space = space[i]) col = f(seq(-1, 1, length = 100)) hc_points(hc, ir, np = 3, gp = gpar(col = col, fill = col)) upViewport() } upViewport() ## ----with_matrix_name----------------------------------------------------------------------------- Heatmap(mat, name = "foo") ## ----heatmap_legend_title------------------------------------------------------------------------- Heatmap(mat, heatmap_legend_param = list(title = "legend")) ## ----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")) ## ----title_rotation------------------------------------------------------------------------------- Heatmap(mat, name = "foo", row_title = "row title", row_title_rot = 0) ## ----cluster_basic-------------------------------------------------------------------------------- Heatmap(mat, name = "foo", cluster_rows = FALSE) Heatmap(mat, name = "foo", show_column_dend = FALSE) Heatmap(mat, name = "foo", row_dend_side = "right") Heatmap(mat, name = "foo", column_dend_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_character_matrix--------------------------------------------------------------------- mat_letters = matrix(sample(letters[1:4], 100, replace = TRUE), 10) # distance in th ASCII table dist_letters = function(x, y) { x = strtoi(charToRaw(paste(x, collapse = "")), base = 16) y = strtoi(charToRaw(paste(y, collapse = "")), base = 16) sqrt(sum((x - y)^2)) } Heatmap(mat_letters, name = "foo", col = structure(2:5, names = letters[1:4]), clustering_distance_rows = dist_letters, clustering_distance_columns = dist_letters, cell_fun = function(j, i, x, y, w, h, col) { grid.text(mat_letters[i, j], x, y) }) ## ----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_dendsort, fig.width = 14------------------------------------------------------------- pushViewport(viewport(layout = grid.layout(nr = 1, nc = 3))) pushViewport(viewport(layout.pos.row = 1, layout.pos.col = 1)) draw(Heatmap(mat, name = "foo", row_dend_reorder = FALSE, column_title = "no reordering"), newpage = FALSE) upViewport() pushViewport(viewport(layout.pos.row = 1, layout.pos.col = 2)) draw(Heatmap(mat, name = "foo", row_dend_reorder = TRUE, column_title = "applied reordering"), newpage = FALSE) upViewport() library(dendsort) dend = dendsort(hclust(dist(mat))) pushViewport(viewport(layout.pos.row = 1, layout.pos.col = 3)) draw(Heatmap(mat, name = "foo", cluster_rows = dend, row_dend_reorder = FALSE, column_title = "reordering by dendsort"), newpage = FALSE) upViewport(2) ## ----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) as.dendrogram(diana(m)), cluster_columns = function(m) as.dendrogram(agnes(m))) ## ------------------------------------------------------------------------------------------------- # code not run when building the vignette Heatmap(mat, name = "foo", cluster_rows = function(m) fastcluster::hclust(dist(m)), cluster_columns = function(m) fastcluster::hclust(dist(m))) # for column cluster, m will be automatically transposed ## ------------------------------------------------------------------------------------------------- # code not run when building the vignette ht_global_opt(fast_hclust = TRUE) # now hclust from fastcluster package is used in all heatmaps Heatmap(mat, name = "foo") ## ----manual_order--------------------------------------------------------------------------------- Heatmap(mat, name = "foo", cluster_rows = FALSE, cluster_columns = FALSE, row_order = 12:1, column_order = 10:1) ## ----dimension_name------------------------------------------------------------------------------- Heatmap(mat, name = "foo", row_names_side = "left", row_dend_side = "right", column_names_side = "top", column_dend_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 = factor(rep(c("A", "B"), 6), levels = c("B", "A")), 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_row_order------------------------------------------------------------------------------ Heatmap(mat, name = "foo", row_order = 12:1, cluster_rows = FALSE, km = 2) ## ----split_gap------------------------------------------------------------------------------------ Heatmap(mat, name = "foo", split = paste0("pam", pa$clustering), gap = unit(5, "mm")) ## ----split_discrete_matrix------------------------------------------------------------------------ Heatmap(discrete_mat, name = "foo", col = 1:4, split = rep(letters[1:2], each = 5)) ## ----split_graphical_parameter-------------------------------------------------------------------- Heatmap(mat, name = "foo", km = 2, row_title_gp = gpar(col = c("red", "blue"), font = 1:2), row_names_gp = gpar(col = c("green", "orange"), fontsize = c(10, 14))) ## ----split_dendrogram----------------------------------------------------------------------------- dend = hclust(dist(mat)) dend = color_branches(dend, k = 2) Heatmap(mat, name = "foo", cluster_rows = dend, split = 2) ## ------------------------------------------------------------------------------------------------- Heatmap(mat, name = "foo", split = 2) ## ----rect_gp-------------------------------------------------------------------------------------- Heatmap(mat, name = "foo", rect_gp = gpar(col = "green", lty = 2, lwd = 2)) ## ------------------------------------------------------------------------------------------------- Heatmap(mat, name = "foo", cell_fun = function(j, i, x, y, width, height, fill) { grid.text(sprintf("%.1f", mat[i, j]), x, y, gp = gpar(fontsize = 10)) }) ## ----cell_fun, fig.width = 6.5, fig.height = 6---------------------------------------------------- cor_mat = cor(mat) od = hclust(dist(cor_mat))$order cor_mat = cor_mat[od, od] nm = rownames(cor_mat) col_fun = circlize::colorRamp2(c(-1, 0, 1), c("green", "white", "red")) # `col = col_fun` here is used to generate the legend Heatmap(cor_mat, name = "correlation", col = col_fun, rect_gp = gpar(type = "none"), cell_fun = function(j, i, x, y, width, height, fill) { grid.rect(x = x, y = y, width = width, height = height, gp = gpar(col = "grey", fill = NA)) if(i == j) { grid.text(nm[i], x = x, y = y) } else if(i > j) { grid.circle(x = x, y = y, r = abs(cor_mat[i, j])/2 * min(unit.c(width, height)), gp = gpar(fill = col_fun(cor_mat[i, j]), col = NA)) } else { grid.text(sprintf("%.1f", cor_mat[i, j]), x, y, gp = gpar(fontsize = 8)) } }, cluster_rows = FALSE, cluster_columns = FALSE, show_row_names = FALSE, show_column_names = FALSE) ## ------------------------------------------------------------------------------------------------- str = "B[cp];W[pq];B[dc];W[qd];B[eq];W[od];B[de];W[jc];B[qk];W[qn] ;B[qh];W[ck];B[ci];W[cn];B[hc];W[je];B[jq];W[df];B[ee];W[cf] ;B[ei];W[bc];B[ce];W[be];B[bd];W[cd];B[bf];W[ad];B[bg];W[cc] ;B[eb];W[db];B[ec];W[lq];B[nq];W[jp];B[iq];W[kq];B[pp];W[op] ;B[po];W[oq];B[rp];W[ql];B[oo];W[no];B[pl];W[pm];B[np];W[qq] ;B[om];W[ol];B[pk];W[qp];B[on];W[rm];B[mo];W[nr];B[rl];W[rk] ;B[qm];W[dp];B[dq];W[ql];B[or];W[mp];B[nn];W[mq];B[qm];W[bp] ;B[co];W[ql];B[no];W[pr];B[qm];W[dd];B[pn];W[ed];B[bo];W[eg] ;B[ef];W[dg];B[ge];W[gh];B[gf];W[gg];B[ek];W[ig];B[fd];W[en] ;B[bn];W[ip];B[dm];W[ff];B[cb];W[fe];B[hp];W[ho];B[hq];W[el] ;B[dl];W[fk];B[ej];W[fp];B[go];W[hn];B[fo];W[em];B[dn];W[eo] ;B[gp];W[ib];B[gc];W[pg];B[qg];W[ng];B[qc];W[re];B[pf];W[of] ;B[rc];W[ob];B[ph];W[qo];B[rn];W[mi];B[og];W[oe];B[qe];W[rd] ;B[rf];W[pd];B[gm];W[gl];B[fm];W[fl];B[lj];W[mj];B[lk];W[ro] ;B[hl];W[hk];B[ik];W[dk];B[bi];W[di];B[dj];W[dh];B[hj];W[gj] ;B[li];W[lh];B[kh];W[lg];B[jn];W[do];B[cl];W[ij];B[gk];W[bl] ;B[cm];W[hk];B[jk];W[lo];B[hi];W[hm];B[gk];W[bm];B[cn];W[hk] ;B[il];W[cq];B[bq];W[ii];B[sm];W[jo];B[kn];W[fq];B[ep];W[cj] ;B[bk];W[er];B[cr];W[gr];B[gk];W[fj];B[ko];W[kp];B[hr];W[jr] ;B[nh];W[mh];B[mk];W[bb];B[da];W[jh];B[ic];W[id];B[hb];W[jb] ;B[oj];W[fn];B[fs];W[fr];B[gs];W[es];B[hs];W[gn];B[kr];W[is] ;B[dr];W[fi];B[bj];W[hd];B[gd];W[ln];B[lm];W[oi];B[oh];W[ni] ;B[pi];W[ki];B[kj];W[ji];B[so];W[rq];B[if];W[jf];B[hh];W[hf] ;B[he];W[ie];B[hg];W[ba];B[ca];W[sp];B[im];W[sn];B[rm];W[pe] ;B[qf];W[if];B[hk];W[nj];B[nk];W[lr];B[mn];W[af];B[ag];W[ch] ;B[bh];W[lp];B[ia];W[ja];B[ha];W[sf];B[sg];W[se];B[eh];W[fh] ;B[in];W[ih];B[ae];W[so];B[af]" ## ------------------------------------------------------------------------------------------------- str = gsub("\\n", "", str) step = strsplit(str, ";")[[1]] type = gsub("(B|W).*", "\\1", step) row = gsub("(B|W)\\[(.).\\]", "\\2", step) column = gsub("(B|W)\\[.(.)\\]", "\\2", step) mat = matrix(nrow = 19, ncol = 19) rownames(mat) = letters[1:19] colnames(mat) = letters[1:19] for(i in seq_along(row)) { mat[row[i], column[i]] = type[i] } mat ## ---- fig.width = 8, fig.height = 8--------------------------------------------------------------- Heatmap(mat, name = "go", rect_gp = gpar(type = "none"), cell_fun = function(j, i, x, y, w, h, col) { grid.rect(x, y, w, h, gp = gpar(fill = "#dcb35c", col = NA)) if(i == 1) { grid.segments(x, y-h*0.5, x, y) } else if(i == nrow(mat)) { grid.segments(x, y, x, y+h*0.5) } else { grid.segments(x, y-h*0.5, x, y+h*0.5) } if(j == 1) { grid.segments(x, y, x+w*0.5, y) } else if(j == ncol(mat)) { grid.segments(x-w*0.5, y, x, y) } else { grid.segments(x-w*0.5, y, x+w*0.5, y) } if(i %in% c(4, 10, 16) & j %in% c(4, 10, 16)) { grid.points(x, y, pch = 16, size = unit(2, "mm")) } r = min(unit.c(w, h))*0.45 if(is.na(mat[i, j])) { } else if(mat[i, j] == "W") { grid.circle(x, y, r, gp = gpar(fill = "white", col = "white")) } else if(mat[i, j] == "B") { grid.circle(x, y, r, gp = gpar(fill = "black", col = "black")) } }, col = c("B" = "black", "W" = "white"), show_row_names = FALSE, show_column_names = FALSE, column_title = "One famous GO game", heatmap_legend_param = list(title = "Player", at = c("B", "W"), labels = c("player1", "player2"), grid_border = "black") ) ## ------------------------------------------------------------------------------------------------- sessionInfo()