Adding decorate_annotation to vertical joined upset plots within ComplexHeatmap package

Solution 1:

The solution shown below is based on the command as.ggplot of the ggplotify package. A function plot_upset is first defined; it draws an upset plot with decorated heatmap annotation. The plot generated by this function is converted in a ggplot object by as.ggplotand stored in ht_list.

library(ComplexHeatmap)
library(patchwork)
library(ggplotify)

movies <- read.csv(system.file("extdata", "movies.csv", package = "UpSetR"), 
                   header = TRUE, sep = ";")

genre <- c("Action", "Romance", "Horror", "Children", "SciFi", "Documentary")
rating <- cut(movies$AvgRating, c(0, 1, 2, 3, 4, 5))
m_list <- tapply(seq_len(nrow(movies)), rating, function(ind) {
  m <- make_comb_mat(movies[ind, genre, drop = FALSE])
  m[comb_degree(m) > 0]
})
m_list <- normalize_comb_mat(m_list)

max_set_size <- max(sapply(m_list, set_size))

plot_upset <- function(m, name, maxSetSize) {
  cs = comb_size(m)  
  ht <- UpSet(m, row_title = paste0("rating in", name),
              set_order = NULL, comb_order = NULL,
              top_annotation = HeatmapAnnotation(
                "Genre Intersections" = anno_barplot(cs, 
                                                     ylim = c(0, max(cs)*1.1),
                                                     border = FALSE, 
                                                     gp = gpar(fill = "black"), 
                                                     height = unit(4, "cm")
                ),
                annotation_name_side = "left", 
                annotation_name_rot = 90),
              right_annotation = upset_right_annotation(m, ylim = c(0, maxSetSize)))
  ht = draw(ht)
  od = column_order(ht)
  decorate_annotation("Genre Intersections", {
    grid.text(cs[od], x = seq_along(cs), y = unit(cs[od], "native") + unit(2, "pt"), 
              default.units = "native", just = c("left", "bottom"), 
              gp = gpar(fontsize = 6, col = "#404040"), rot = 45)
  })
}

ht_list <- vector(2, mode="list")
for(i in seq_along(m_list)) {
  m <- m_list[[i]]
  name_m <- names(m_list)[i]
  dht <- as.ggplot( ~ plot_upset(m, name_m, max_set_size))
  ht_list[[i]] <- dht
} 
patchwork::wrap_plots(ht_list, ncol=1)

Here is the final plot (only 3 of the 5 plots are reported).