Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Anno_textbox not scaling when saving image #1161

Open
Sandman-1 opened this issue Feb 5, 2024 · 0 comments
Open

Anno_textbox not scaling when saving image #1161

Sandman-1 opened this issue Feb 5, 2024 · 0 comments

Comments

@Sandman-1
Copy link

Sandman-1 commented Feb 5, 2024

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 <- dataset@meta.data %>%
            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@assays$RNA@scale.data, 0.02),
0,
quantile(metacell@assays$RNA@scale.data, 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
p

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Labels
None yet
Projects
None yet
Development

No branches or pull requests

1 participant