Anno_textbox not scaling when saving image

[Sandman-1]

Hello! Thank you so much for such an awesome package. I don't know how you came up with this stuff, but God bless you for it!

I constructed the following heatmap, but upon saving it to both png and pdf format, I realized that the annotation_textbox did not scale with the rest of heatmap. I was wondering if you knew how to fix this. Also, is there a way to remove the slice names when splitting the heatmap?

Heatmap Plotting Function (from Scillus Package): ` plot_heatmap <- function(dataset, markers, sort_var = c('seurat_clusters'), anno_var, anno_colors, hm_limit = c(-2, 0, 2), hm_colors = c("#4575b4","white","#d73027"), n = 8, row_split = NULL, left_annotation = NULL, variable_annotation_side = "right", row_font_size = 12) {

    mat <- GetAssayData(object = dataset, assay = DefaultAssay(dataset), slot = "scale.data")
    
    if (is.data.frame(markers)) {
        genes <- get_top_genes(dataset, markers, n)
    } else if (is.character(markers)) {
        genes <- markers
    } else {
        stop('Incorrect input of markers')
    }
    
    mat <- mat[match(genes, rownames(mat)),]
    
    anno <- [email protected] %>%
            rownames_to_column(var = "barcode") %>%
            arrange(!!!syms(sort_var))
    
    mat <- t(mat)
    mat <- mat[match(anno$barcode, rownames(mat)),]
    mat <- t(mat)

    annos <- list()
    
    for (i in seq_along(1:length(anno_var))) {
            err_msg <- paste('Incorrect specification for annotation colors for', anno_var[i])
            value <- anno[[anno_var[i]]]
            if (is.numeric(value)) {
                if (all(anno_colors[[i]] %in% rownames(brewer.pal.info)[brewer.pal.info$category != 'qual'])) {
                    n <- brewer.pal.info[anno_colors[[i]],]['maxcolors'][[1]]
                    pal <- brewer.pal(n = n, name = anno_colors[[i]])
                    col_fun <- colorRamp2(c(min(value), stats::median(value), max(value)), 
                                          c(pal[2], pal[(n+1)/2], pal[n-1]))
                } else if (length(anno_colors[[i]]) == 3 & all(are_colors(anno_colors[[i]]))) {
                    col_fun <- colorRamp2(c(min(value), stats::median(value), max(value)), 
                                          anno_colors[[i]])
                } else {
                    stop(err_msg)
                }
                    
                ha <- HeatmapAnnotation(a = anno[[anno_var[i]]],
                                        col = list(a = col_fun),
                                        border = T,
                                        annotation_label = gsub("_", " ", anno_var[i]),
                                        annotation_legend_param = list(a = list(
                                          title = gsub("_", " ", anno_var[i]))),
                                        annotation_name_side = variable_annotation_side)
            } else {
                
                l <- levels(factor(anno[[anno_var[i]]]))
                
                if (all(anno_colors[[i]] %in% rownames(brewer.pal.info))) {
                    
                    col <- set_colors(anno_colors[[i]], length(l))
                    
                } else if (length(anno_colors[[i]]) >= length(l) & all(are_colors(anno_colors[[i]]))) {
                    
                    col <- anno_colors[[i]]
                    
                } else {
                    stop(err_msg)
                }
                
                names(col) <- l
                col <- col[!is.na(names(col))]
                col <- list(a = col)
                    
                ha <- HeatmapAnnotation(a = anno[[anno_var[i]]],
                                        col = col,
                                        border = T,
                                        annotation_label = gsub("_", " ", anno_var[i]),
                                        annotation_legend_param = list(a = list(
                                          title = gsub("_", " ", anno_var[i]))),
                                        annotation_name_side = variable_annotation_side)
            }
            names(ha) <- anno_var[i]
            
            annos[[i]] <- ha
    }
    
    annos <- do.call(c, annos)
    
    annos@gap <- rep(unit(1,"mm"), length(annos))
    
    if(is.null(left_annotation)){
      ht <- Heatmap(mat,
                  cluster_rows = F,
                  cluster_columns = F,
                  heatmap_legend_param = list(direction = "horizontal",
                                              legend_width = unit(6, "cm"),
                                              title = "Expression"),
                  col = colorRamp2(hm_limit, hm_colors),
                  show_column_names = F,
                  row_names_side = rowname_side,
                  row_names_gp = gpar(fontsize = row_font_size),
                  row_names_max_width = max_text_width(
                    rownames(mat), 
                    gp = gpar(fontsize = row_font_size)),
                  top_annotation = annos)
    } else if(!is.null(left_annotation)){
      ht <- Heatmap(mat,
                  cluster_rows = F,
                  cluster_columns = F,
                  heatmap_legend_param = list(direction = "horizontal",
                                              legend_width = unit(6, "cm"),
                                              title = "Expression"),
                  col = colorRamp2(hm_limit, hm_colors),
                  show_column_names = F,
                  show_row_names = F,
                  row_split = row_split,
                  cluster_row_slices = F,
                  left_annotation = left_annotation,
                  row_names_gp = gpar(fontsize = row_font_size),
                  row_names_max_width = max_text_width(
                    rownames(mat), 
                    gp = gpar(fontsize = row_font_size)),
                  top_annotation = annos)
    }
    
    draw(ht, 
         heatmap_legend_side = "bottom",
         annotation_legend_side = variable_annotation_side)

} `

Code to Create Heatmap: ` row_anno <- rowAnnotation(Module = anno_empty(border = F, width = max_text_width(unlist(hub_genes_list), gp = gpar(fontsize = 8)) + unit(4, "mm"))) row_subsections <- lengths(genes_in_modules) row_chunks <- rep(seq(1:length(row_subsections)), row_subsections) row_split = data.frame(row_chunks) row_split$row_chunks <- rep(module_order, row_subsections) heatmap_annotation_full <- rowAnnotation( Hub_Genes = anno_textbox(align_to = row_chunks, text = plyr::rename(hub_genes_list, replace = c(seq(1:20)) %>% magrittr::set_names(names(hub_genes_list))), background_gp = gpar(fill = "white", col = "grey"), gp = gpar(col = "black", fontsize = 6), add_new_line = TRUE, side = "left"), Module = anno_block(gp = gpar(fill = names(hub_genes_list))), show_annotation_name = FALSE)

png(filename = "Output Files/Metacells/Images/Module Gene Expression Heatmap.png", width = 15, height = 12, units = "in", res = 720) plot_heatmap(dataset = metacell, markers = scaled_genes, sort_var = c("Cell_Subtype", "Pseudotime"), anno_var = c("Cell_Subtype", "Fine_Status"), anno_colors = list(cell_type_cols, status_cols), hm_limit = c(quantile(metacell@[email protected], 0.02), 0, quantile(metacell@[email protected], 0.98)), hm_colors = c("blue","white","red"), row_split = row_split, left_annotation = heatmap_annotation_full, variable_annotation_side = "right", row_font_size = 6) dev.off() `

p.pdf