How can I highlight only specific rows by drawing rectangle around the corresponding cells of the row or by making the row name bold and colored as shown below in the image (pointed to with arrows). Many thanks.
# remotes::install_github("jokergoo/ComplexHeatmap")
library("ComplexHeatmap")
set.seed(123)
nr1 = 4; nr2 = 8; nr3 = 6; nr = nr1 + nr2 + nr3
nc1 = 6; nc2 = 8; nc3 = 10; nc = nc1 + nc2 + nc3
mat = cbind(rbind(matrix(rnorm(nr1*nc1, mean = 1, sd = 0.5), nr = nr1),
matrix(rnorm(nr2*nc1, mean = 0, sd = 0.5), nr = nr2),
matrix(rnorm(nr3*nc1, mean = 0, sd = 0.5), nr = nr3)),
rbind(matrix(rnorm(nr1*nc2, mean = 0, sd = 0.5), nr = nr1),
matrix(rnorm(nr2*nc2, mean = 1, sd = 0.5), nr = nr2),
matrix(rnorm(nr3*nc2, mean = 0, sd = 0.5), nr = nr3)),
rbind(matrix(rnorm(nr1*nc3, mean = 0.5, sd = 0.5), nr = nr1),
matrix(rnorm(nr2*nc3, mean = 0.5, sd = 0.5), nr = nr2),
matrix(rnorm(nr3*nc3, mean = 1, sd = 0.5), nr = nr3))
)
mat = mat[sample(nr, nr), sample(nc, nc)] # random shuffle rows and columns
rownames(mat) = paste0("row", seq_len(nr))
colnames(mat) = paste0("column", seq_len(nc))
Heatmap(mat)
Here's a solution for performing both tasks:
set.seed(123)
nr1 = 4; nr2 = 8; nr3 = 6; nr = nr1 + nr2 + nr3
nc1 = 6; nc2 = 8; nc3 = 10; nc = nc1 + nc2 + nc3
mat = cbind(rbind(matrix(rnorm(nr1*nc1, mean = 1, sd = 0.5), nr = nr1),
matrix(rnorm(nr2*nc1, mean = 0, sd = 0.5), nr = nr2),
matrix(rnorm(nr3*nc1, mean = 0, sd = 0.5), nr = nr3)),
rbind(matrix(rnorm(nr1*nc2, mean = 0, sd = 0.5), nr = nr1),
matrix(rnorm(nr2*nc2, mean = 1, sd = 0.5), nr = nr2),
matrix(rnorm(nr3*nc2, mean = 0, sd = 0.5), nr = nr3)),
rbind(matrix(rnorm(nr1*nc3, mean = 0.5, sd = 0.5), nr = nr1),
matrix(rnorm(nr2*nc3, mean = 0.5, sd = 0.5), nr = nr2),
matrix(rnorm(nr3*nc3, mean = 1, sd = 0.5), nr = nr3))
)
mat = mat[sample(nr, nr), sample(nc, nc)] # random shuffle rows and columns
rownames(mat) = paste0("row", seq_len(nr))
colnames(mat) = paste0("column", seq_len(nc))
# Rows to highlight
myRows <- c('row2', 'row7')
# Set stylings for row names and make our selected rows unique
row_idx <- which(rownames(mat) %in% myRows)
fontsizes <- rep(10, nrow(mat))
fontsizes[row_idx] <- 18
fontcolors <- rep('black', nrow(mat))
fontcolors[row_idx] <- 'red'
fontfaces <- rep('plain',nrow(mat))
fontfaces[row_idx] <- 'bold'
# Create text annotation object for displaying row names
rowAnno <- rowAnnotation(rows = anno_text(rownames(mat), gp = gpar(fontsize = fontsizes, fontface = fontfaces, col = fontcolors)))
# Create our own row dendrogram (ComplexHeatmap orders rows by mean by default)
dend <- reorder(as.dendrogram(hclust(dist(mat))), -rowMeans(mat), agglo.FUN = mean)
# Find rows in dendrogram
dend_idx <- which(order.dendrogram(dend) %in% which(rownames(mat) %in% myRows))
# Find bottom and top of each row on heatmap (x and y axes go from 0 to 1)
btm <- 1 - (dend_idx / nrow(mat))
top <- btm + (1/nrow(mat))
# Draw the heatmap using our own row clustering and text decorations
Heatmap(mat, name = "ht", cluster_rows = dend, right_annotation = rowAnno, show_row_names = FALSE)
# Add boxes around our rows
box_col <- 'black'
box_width <- 3
decorate_heatmap_body("ht", { for (i in 1:length(myRows)) {
grid.lines(c(0, 1), c(top[i],top[i]), gp = gpar(lty = 1, lwd = box_width, col = box_col))
grid.lines(c(0, 1), c(btm[i],btm[i]), gp = gpar(lty = 1, lwd = box_width, col = box_col))
grid.lines(c(0, 0), c(btm[i],top[i]), gp = gpar(lty = 1, lwd = box_width, col = box_col))
grid.lines(c(1, 1), c(btm[i],top[i]), gp = gpar(lty = 1, lwd = box_width, col = box_col))
}
})
If you love us? You can donate to us via Paypal or buy me a coffee so we can maintain and grow! Thank you!
Donate Us With