Add pch to rowAnnotation when the input is a data frame with variable number of continuous columns

Question

Following up on this question, I am using ComplexHeatmap inside a function that takes as input the variable names that I want to study.

While before I found trouble with the discrete grouping of my columns, now the problem is different. I want to plot additional continuous columns (stored in a different data frame) with significance * (as pch) associated to them.

I normally know how to do this with rowAnnotation and anno_simple, but in this case (of ComplexHeatmap inside a function), where I do not know the names (or the number!) of the extra columns to add, I have no clue.

I was hoping the answer to the previous question would apply to this too, and I almost got it, but still not quite there yet...

The following is my MWE.

I first define my inputs, the heatmap matrix heat_mat, the extra_df with the extra columns to add, and the color palettes to apply:

data(iris)
extra_cols <- c('zscore1', 'zscore2') #they can be 1, 2, 3... n
extra_pch <- c('pvalue1','pvalue2') #they can be 1, 2, 3... n
iris_sub <- rbind(iris[iris[,'Species']=='setosa',][1:5,],
                  iris[iris[,'Species']=='versicolor',][1:5,],
                  iris[iris[,'Species']=='virginica',][1:5,])
heat_mat <- as.matrix(iris_sub[,-ncol(iris_sub)])
#
extra_df <- data.frame(ID=paste0("id",rownames(iris_sub)))
for (i in 1:length(extra_cols)){
  edf <- data.frame(VAR=rnorm(15))
  names(edf) <- extra_cols[i]
  pdf <- data.frame(VAR=runif(15, 0, 0.2))
  pdf$VAR <- ifelse(pdf$VAR<0.05, '*', NA)
  names(pdf) <- extra_pch[i]
  extra_df <- cbind(extra_df, edf, pdf)
}
rownames(heat_mat) <- extra_df$ID
#
palette1 <- RColorBrewer::brewer.pal(n=9, name="RdYlGn")
palette2 <- RColorBrewer::brewer.pal(n=9, name="RdYlBu")
#
cols_list <- list()
for (nm in extra_cols){
  breaks <- seq(from=min(extra_df[,nm]), to=max(extra_df[,nm]), length.out=length(palette2))
  cols <- circlize::colorRamp2(breaks, palette2)
  cols_list <- append(cols_list, cols)
  names(cols_list)[length(cols_list)] <- nm
}

Now I would know how to do the heat map normally with rowAnnotation and anno_simple, like this:

row_ha <- ComplexHeatmap::rowAnnotation(
  zscore1 = ComplexHeatmap::anno_simple(
    extra_df[,extra_cols[1]], col = cols_list[[extra_cols[1]]],
    pch = extra_df[,extra_pch[1]]),
  zscore2 = ComplexHeatmap::anno_simple(
    extra_df[,extra_cols[2]], col = cols_list[[extra_cols[2]]],
    pch = extra_df[,extra_pch[2]]))
#
complex_heat <- ComplexHeatmap::Heatmap(heat_mat, name = "value", cluster_columns = FALSE,
                                        col = palette1,
                                        right_annotation = row_ha,
                                        border = TRUE)
grDevices::png(filename="test.png", height=600, width=400)
ComplexHeatmap::draw(complex_heat)
grDevices::dev.off()

This produces the following plot, which is exactly what I need (not worried about the absence of legends for this example):

However, as stated before, in my current case (of ComplexHeatmap inside a function), I do not know the names (or the number!) of the extra columns to add.

I would like to add a variable number of continuous columns with their associated pch as rowAnnotation, for which the names are stored in 2 variables.

This is my best attempt (applying the answer to the previous question), but with this approach I cannot pass pch.

row_df <- extra_df[,extra_cols,drop=F]
row_pch <- extra_df[,extra_pch,drop=F]
row_ha <- ComplexHeatmap::rowAnnotation(
  df = row_df,
  col = cols_list,
  #pch = row_pch,
  show_legend = FALSE)
#
complex_heat <- ComplexHeatmap::Heatmap(heat_mat, name = "value", cluster_columns = FALSE,
                                        col = palette1,
                                        right_annotation = row_ha,
                                        border = TRUE)
grDevices::png(filename="test2.png", height=600, width=400)
ComplexHeatmap::draw(complex_heat)
grDevices::dev.off()

This produces the following plot, identical to the previous, but without the * which I need... Any idea how to proceed?

Answer 1

I think in this case, it might be easier to just generate a second heatmap and just plot it right next to the main one. The code for this would look something like this:

data(iris)
extra_cols <- c('zscore1', 'zscore2') #they can be 1, 2, 3... n
extra_pch <- c('pvalue1','pvalue2') #they can be 1, 2, 3... n
iris_sub <- rbind(iris[iris[,'Species']=='setosa',][1:5,],
                  iris[iris[,'Species']=='versicolor',][1:5,],
                  iris[iris[,'Species']=='virginica',][1:5,])
heat_mat <- as.matrix(iris_sub[,-ncol(iris_sub)])
#
extra_df <- data.frame(ID=paste0("id",rownames(iris_sub)))
for (i in 1:length(extra_cols)){
  edf <- data.frame(VAR=rnorm(15))
  names(edf) <- extra_cols[i]
  pdf <- data.frame(VAR=runif(15, 0, 0.2))
  pdf$VAR <- ifelse(pdf$VAR<0.05, '*', NA)
  names(pdf) <- extra_pch[i]
  extra_df <- cbind(extra_df, edf, pdf)
}
rownames(heat_mat) <- extra_df$ID

palette1 <- RColorBrewer::brewer.pal(n=9, name="RdYlGn")
palette2 <- RColorBrewer::brewer.pal(n=9, name="RdYlBu")

cols_list <- list()
for (nm in extra_cols){
  breaks <- seq(from=min(extra_df[,nm]), to=max(extra_df[,nm]), length.out=length(palette2))
  cols <- circlize::colorRamp2(breaks, palette2)
  cols_list <- append(cols_list, cols)
  names(cols_list)[length(cols_list)] <- nm
}

secondary_heatmap_data <- as.matrix(extra_df[, extra_cols])
rownames(secondary_heatmap_data) <- extra_df$ID

main_heatmap <- ComplexHeatmap::Heatmap(heat_mat, name = "value", cluster_columns = FALSE,
                                        col = palette1,
                                        #right_annotation = row_ha,
                                        border = TRUE)
secondary_heatmap <- ComplexHeatmap::Heatmap(secondary_heatmap_data,
  cluster_columns = FALSE,
  layer_fun = function(j, i, x, y, width, height, fill) {
    # since grid.text can also be vectorized
    grid.text(ifelse(pindex(secondary_heatmap_data, i, j) < 0.05, "*", ""), x, y,
      gp = gpar(fontsize = 11, col = "black") # adjust as needed
    )
  },
  border = FALSE,
  width = unit(1, "cm"),
  show_heatmap_legend = FALSE
)

ht_list <- main_heatmap + secondary_heatmap
draw(ht_list, main_heatmap = "value")

This produces the following heatmap, which looks very similar to the one created with anno_simple: