how to use netVisual_heatmap() to compare heatmaps on the same scale

[hermioneallen]

Hi,

Thanks for such a great package, and the new update!

I'm using cellchat to compare two datasets and the netVisual_heatmap() function to compare heatmaps for cell type interactions between all of my clusters. However, I found that while the function can plot the heatmaps side by side, they are plotted separately and so the scales are different, making comparison quite tricky.

Here's an example plot with the heatmaps next to each other - the red boxes illustrate the different scales.

Also, when the heatmaps are next to each other, only one communication probability legend is shown. The scale on this differs when the heatmaps are plotted individually, so this legend only applies to one heatmap, which is misleading.

Is there an effective workaround that can be used to plot both heatmaps to the same scale? I tried finding the source of the max values in the heatmap objects but couldn't work it out as the way the netVisual_heatmap function interacts with ComplexHeatmap is pretty complex and definitely beyond my coding skills.

Any help would be greatly appreciated!

[sqjin]

@hermioneallen Thanks for pointing it out. I will try to address it in next few days.

[JessicaChevallier]

Hi,

@sqjin I was wondering if you had the chance to implement a scale parameter in the netVisual_heatmap function to be able to compare heatmaps across conditions as @hermioneallen suggested?

Thank you!

[sqjin]

@JessicaChevallier Have you tried netVisual_heatmap(cellchat.merged)? Using the merged object as input directly compares the signaling between two conditions.

[JessicaChevallier]

Updating the cellchat objects to the latest version and then merging them worked. All heatmaps now have the same scale across conditions. Thank you @sqjin!

[laijen000]

hi @JessicaChevallier @sqjin , my heatmaps are still not on the same scale despite using the latest cellchat v2 and updating my objects. could you elaborate on how you got this to work? thank you!

[JessicaChevallier]

Hi,

Sorry for replying just now! In my case I had ran CellChat using an older version of the package. I ended up updating all the CellChat objects using updateCellChat then merging the updated objects together. After that, running netVisual_heatmap on the merged object worked and the same scale was applied. I hope that helps!

[WayGW]

I think there is some miscommunication happening. When people are saying they want the same scale bars across the groups is when they are using the objectlist of individual cellchat objects in code like this to see the signaling in the pathway:

pathways.show <- c("SPP1") par(mfrow = c(1,2), xpd=TRUE) ht <- list() for (i in 1:length(object.list)) { ht[[i]] <- netVisual_heatmap(object.list[[i]], signaling = pathways.show, color.heatmap = "Reds",title.name = paste(pathways.show, "signaling ",names(object.list)[i])) }

Do heatmap based on a single object

ComplexHeatmap::draw(ht[[2]] + ht[[1]] + ht[[4]] + ht[[3]], ht_gap = unit(0.5, "cm"))

When using the netvisual_heatmap on the merged cell chat object you get a relative expression heatmap that shows one heatmap (resulting from comparing the two). People are asking how to make the code above use the same scale to visualize the change in signaling of the pathway heatmaps separately.

[YISEULKIM5217]

netAnalysis_signalingRole_heatmap <- function(object, signaling = NULL, pattern = c("outgoing", "incoming","all"), slot.name = "netP",
                                              color.use = NULL, color.heatmap = "BuGn",
                                              title = NULL, width = 10, height = 8, font.size = 8, font.size.title = 10, cluster.rows = FALSE, cluster.cols = FALSE){
  pattern <- match.arg(pattern)
  if (length(slot(object, slot.name)$centr) == 0) {
    stop("Please run `netAnalysis_computeCentrality` to compute the network centrality scores! ")
  }
  centr <- slot(object, slot.name)$centr
  outgoing <- matrix(0, nrow = nlevels(object@idents), ncol = length(centr))
  incoming <- matrix(0, nrow = nlevels(object@idents), ncol = length(centr))
  dimnames(outgoing) <- list(levels(object@idents), names(centr))
  dimnames(incoming) <- dimnames(outgoing)
  for (i in 1:length(centr)) {
    outgoing[,i] <- centr[[i]]$outdeg
    incoming[,i] <- centr[[i]]$indeg
  }
  if (pattern == "outgoing") {
    mat <- t(outgoing)
    legend.name <- "Outgoing"
  } else if (pattern == "incoming") {
    mat <- t(incoming)
    legend.name <- "Incoming"
  } else if (pattern == "all") {
    mat <- t(outgoing+ incoming)
    legend.name <- "Overall"
  }
  if (is.null(title)) {
    title <- paste0(legend.name, " signaling patterns")
  } else {
    title <- paste0(paste0(legend.name, " signaling patterns"), " - ",title)
  }

  if (!is.null(signaling)) {
    mat1 <- mat[rownames(mat) %in% signaling, , drop = FALSE]
    mat <- matrix(0, nrow = length(signaling), ncol = ncol(mat))
    idx <- match(rownames(mat1), signaling)
    mat[idx[!is.na(idx)], ] <- mat1
    dimnames(mat) <- list(signaling, colnames(mat1))
  }
  mat.ori <- mat
  mat <- sweep(mat, 1L, apply(mat, 1, max), '/', check.margin = FALSE)
  mat[mat == 0] <- NA

  if (is.null(color.use)) {
    color.use <- scPalette(length(colnames(mat)))
  }
  color.heatmap.use = grDevices::colorRampPalette((RColorBrewer::brewer.pal(n = 9, name = color.heatmap)))(100)

  df<- data.frame(group = colnames(mat)); rownames(df) <- colnames(mat)
  names(color.use) <- colnames(mat)
  col_annotation <- HeatmapAnnotation(df = df, col = list(group = color.use),which = "column",
                                      show_legend = FALSE, show_annotation_name = FALSE,
                                      simple_anno_size = grid::unit(0.2, "cm"))
  ha2 = HeatmapAnnotation(Strength = anno_barplot(colSums(mat.ori), border = FALSE, 
                                                  gp = gpar(fill = color.use, col=color.use), ylim = c(0, 30)), show_annotation_name = FALSE)

  pSum <- rowSums(mat.ori)
  pSum.original <- pSum
  pSum <- -1/log(pSum)
  pSum[is.na(pSum)] <- 0
  idx1 <- which(is.infinite(pSum) | pSum < 0)
  if (length(idx1) > 0) {
    values.assign <- seq(max(pSum)*1.1, max(pSum)*1.5, length.out = length(idx1))
    position <- sort(pSum.original[idx1], index.return = TRUE)$ix
    pSum[idx1] <- values.assign[match(1:length(idx1), position)]
  }

  ha1 = rowAnnotation(Strength = anno_barplot(pSum, border = FALSE, ylim = c(0, 500)), show_annotation_name = FALSE)

  if (min(mat, na.rm = T) == max(mat, na.rm = T)) {
    legend.break <- max(mat, na.rm = T)
  } else {
    legend.break <- c(round(min(mat, na.rm = T), digits = 1), round(max(mat, na.rm = T), digits = 1))
  }
  ht1 = Heatmap(mat, col = color.heatmap.use, na_col = "white", name = "Relative strength",
                bottom_annotation = col_annotation, top_annotation = ha2, right_annotation = ha1,
                cluster_rows = cluster.rows,cluster_columns = cluster.rows,
                row_names_side = "left",row_names_rot = 0,row_names_gp = gpar(fontsize = font.size),column_names_gp = gpar(fontsize = font.size),
                width = unit(width, "cm"), height = unit(height, "cm"),
                column_title = title,column_title_gp = gpar(fontsize = font.size.title),column_names_rot = 90,
                heatmap_legend_param = list(title_gp = gpar(fontsize = 8, fontface = "plain"),title_position = "leftcenter-rot",
                                            border = NA, at = legend.break,
                                            legend_height = unit(20, "mm"),labels_gp = gpar(fontsize = 8),grid_width = unit(2, "mm"))
  )
  #  draw(ht1)
  return(ht1)
}

I added ylim = c(0,30) in HeatMapAnnotation line

[hermioneallen]

I think there is some miscommunication happening. When people are saying they want the same scale bars across the groups is when they are using the objectlist of individual cellchat objects in code like this to see the signaling in the pathway:

pathways.show <- c("SPP1") par(mfrow = c(1,2), xpd=TRUE) ht <- list() for (i in 1:length(object.list)) { ht[[i]] <- netVisual_heatmap(object.list[[i]], signaling = pathways.show, color.heatmap = "Reds",title.name = paste(pathways.show, "signaling ",names(object.list)[i])) } #Do heatmap based on a single object ComplexHeatmap::draw(ht[[2]] + ht[[1]] + ht[[4]] + ht[[3]], ht_gap = unit(0.5, "cm"))

When using the netvisual_heatmap on the merged cell chat object you get a relative expression heatmap that shows one heatmap (resulting from comparing the two). People are asking how to make the code above use the same scale to visualize the change in signaling of the pathway heatmaps separately.

yes exactly! using the merged cellchat object doesn't give the same the visualisation.

@YISEULKIM5217 this worked for me, thanks so much! in the netvisual_heatmap() function, it's from lines 147-152: ha1 = rowAnnotation(Strength = anno_barplot(rowSums(abs(mat)), border = FALSE, gp = gpar(fill = color.use.row, col = color.use.row), ylim = c(0, 0.005)), show_annotation_name = FALSE) ha2 = HeatmapAnnotation(Strength = anno_barplot(colSums(abs(mat)), border = FALSE, gp = gpar(fill = color.use.col, col = color.use.col), ylim = c(0, 0.004)), show_annotation_name = FALSE)

you need to add ylim to both ha1 and ha2 as there are two y axes on each heatmap. I changed it to the max value out of my two groups I'm comparing, so this would need to be changed with every different pathway plotted depending on interaction strength.

I still haven't worked out how to make the legend the same across both heatmaps so that the colours of the heatmap are directly comparable - you can plot them separately so that both legends are the same which works okay, but isn't perfect

[hermioneallen]

^^adding onto this also be aware that changing the netvisual_heatmap() function will mess up the scale for its other uses (such as when it's used with the merged heatmap object). basically I keep having to edit the function every time I'm using it for a different plot