jokergoo / ComplexHeatmap

Make Complex Heatmaps
https://jokergoo.github.io/ComplexHeatmap-reference/book/
Other
1.31k stars 230 forks source link

Plotting two complex heatmaps one after the other in the same session seems to be taking forever? #835

Closed smk5g5 closed 2 years ago

smk5g5 commented 3 years ago

Hi,

I don't know why but my complexheatmaps get stuck after I am done plotting one heatmap and plot the next heatmap it takes forever to finish. I was wondering if there is a neat trick to overcome this?

For example in this code I don't know what is going wrong in this code in terms of why it is taking forever to plot?

i.e ht_list = ht + ht2

I think at this step 'row_mat' is a binary matrix I tried to plot it as row annotation but I always get

Error: celltype: annotations should be vector/data frame (onlydf)/matrix/functions.

So I am plotting it as a separate heatmap and then cbind unless there is a better way to do it?

makecomplexheatmap_bysymbols2 <- function(aggr_res,row_mat,annot_df,des_col,gsmid,no_of_genes='all',myhite=50,rowfont,htmfont,mywid=30) {
  set.seed(100)
  sel_genes <- intersect(rownames(row_mat),aggr_res$combined_df$Gene_Symbol)
  gse_df <- aggr_res$combined_df
  sub_gsedf <- gse_df[gse_df$Gene_Symbol %in% sel_genes,]
  eset <- aggr_res$combined_eset

  qual_cols = brewer.pal.info[brewer.pal.info$category == "qual", ]
  qual_cols <- qual_cols[qual_cols$colorblind==T,]
  qual_cols
  col_vector = unlist(mapply(brewer.pal, qual_cols$maxcolors, rownames(qual_cols)))

  eset_ligs <- eset[rownames(eset) %in% sub_gsedf$Gene_Symbol,]

  gene_len <- length(rownames(eset_ligs))
  base_mean = rowMeans(eset_ligs)
  mat_scaled = t(scale(t(eset_ligs)))

  index <- match(colnames(eset_ligs),annot_df$gsmid)
  groupdf <- annot_df[['Type']][index]
  subtype_df <- annot_df[['sub_type']][index]
  #hearing_df <- annot_df[['Hearing.loss']][index]
  #nf2_df <-  annot_df[['nf2']][index]
  col_cols <- toupper(c('#f1a340','#998ec3'))
  #names(col_cols) <- c('Control','Tumor')
  names(col_cols) <- c('Vestibular nerve tissue','Vestibular schwannoma tumor')

  subtypes_cols <- sample(col_vector,length(unique(annot_df$sub_type)))
  names(subtypes_cols) <- unique(annot_df$sub_type)

  #hearing_loss_cols <- c('#ef304c','#14c99c','#EEEEEE')
  #names(hearing_loss_cols) <- c('YES','NO','NA')

  #nf2_cols <-  c('#ab002b','#00856F','#4D4D4D')
  #names(nf2_cols) <- c('YES','NO','NA')
  #Hearing_loss=hearing_loss_cols,NF2=nf2_cols  
  #Hearing_loss=hearing_df,NF2=nf2_df
  ha = HeatmapAnnotation(df = data.frame(type = groupdf,subtype=subtype_df),col = list(type = col_cols,subtype=subtypes_cols),gp=gpar(fontsize = 4))

  #des_col = 'Control - Tumor'
  sub_gsedf$genereg[sub_gsedf[[des_col]]==-1] <- 'Downregulation'
  sub_gsedf$genereg[sub_gsedf[[des_col]]==1] <- 'Upregulation'
  sub_gsedf$genereg[sub_gsedf[[des_col]]==0] <- 'No_change'

  index <- match(rownames(mat_scaled),sub_gsedf$Gene_Symbol)
  # rownames(mat_scaled) <- sub_gsedf$Gene_Symbol[index]
  selvals <- sub_gsedf$genereg[index]

  var_genes <- sub_gsedf$variable_Genes[index]

  row_ha = rowAnnotation(diffexp=selvals,variable_gene=var_genes,col = list(diffexp = c("Downregulation" = "red", "Upregulation" = "green", "No_change" = "grey"),variable_gene=c("YES"="#dd2c00","NO"="#8fe7ff")),width = unit(1, "cm"))

  ht <- Heatmap(mat_scaled , name=sprintf("gene expression top5 DEG's by cluster %s",gsmid),
                col=colorRamp2(c(-2, 0, 2), c("blue", "white", "red")),
                top_annotation = ha,right_annotation = row_ha,
                row_names_gp = grid::gpar(fontsize = rowfont, fontface = "bold"),
                show_row_names = T, show_column_names = F,
                show_row_dend = F,show_column_dend = F)
  myrow_ord <- row_order(ht)
  print(length(myrow_ord))
  print(dim(row_mat))
  col_runif = colorRamp2(c(0, 1), c("white", "red"))

  ht2 = Heatmap(row_mat, name = "celltype_binary", col = col_runif,cluster_rows=F,
                column_title = "Celltype top 5 DEG's",row_order=myrow_ord,
                show_row_names = F, show_column_names = T,show_row_dend = F,show_column_dend = F)

  ht_list = ht + ht2

  heatmap_plot = draw(ht_list,legend_title_gp = gpar(fontsize = htmfont, fontface = "bold"),legend_grid_width = unit(1, "cm"), legend_grid_height = unit(1, "cm"))
  png(filename = sprintf("heatmap_%s_%s.png",gsmid,no_of_genes),
      width = mywid, height =myhite , units = "in",
      bg = "white",res=300)
  # Heatmap(mat, name = "mat", cluster_rows = row_dend)
  print(heatmap_plot)
  dev.off()
  ordered_gene_list <- rownames(mat_scaled)[unlist(myrow_ord)]
  return(list(ht=ht_list,scl_mat=mat_scaled,ord_row=myrow_ord,col_ord=column_order(ht),ord_gene_list=ordered_gene_list))
}
jokergoo commented 3 years ago

According to my experience, there were several reasons why plotting heatmap becomes very slow:

  1. a matrix is by mistake degenerated to a long vector.
  2. a matrix is by mistake converted to a character matrix.

If you can also send me the data, I can have a closer look.

I think at this step 'row_mat' is a binary matrix I tried to plot it as row annotation but I always get Error: celltype: annotations should be vector/data frame (only df)/matrix/functions.

I don't know how you set the annotation because I cannot see your code. As the error message shows, it is mostly because the format of celltype is wrong.