Complexheatmap突出显示特定行

Question

如何通过在行的相应单元格周围绘制矩形或将行名设置为粗体和彩色来仅突出显示特定行，如下图所示(用箭头指向)。非常感谢。

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

​

​

Answer 1

下面是执行这两个任务的解决方案：

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

​

​

Answer 2

我能找到的唯一解决方案是使用row_split参数将一行放入它自己的组中。

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

cluster_rows = hclust(dist(mat))
cluster_cols = hclust(dist(t(mat)))

# reorder the matrix according to the clustering
mat_order = mat[cluster_rows$order, cluster_cols$order]

which_row2 = which(grepl("row2", rownames(mat_order)))
split = data.frame(x = c(rep("A", which_row2 - 1),
                     "B",
                     rep("C", nrow(mat_order) - which_row2)))
Heatmap(mat_order,
    cluster_rows = FALSE,
    cluster_columns = FALSE,
    row_split = split,
    row_title = NULL)

​

​