Skip to content

Commit

Permalink
Merge pull request #3 from ycl6/set_uniq_heatmap_names
Browse files Browse the repository at this point in the history
Use unique heatmap name, and other feature updates
  • Loading branch information
ycl6 authored Sep 19, 2023
2 parents 5e66861 + 577d2d7 commit e4b91fb
Show file tree
Hide file tree
Showing 2 changed files with 34 additions and 21 deletions.
48 changes: 29 additions & 19 deletions R/visualization.R
Original file line number Diff line number Diff line change
Expand Up @@ -1776,8 +1776,9 @@ netVisual_diffInteraction <- function(object, comparison = c(1,2), measure = c("
#' @param color.use the character vector defining the color of each cell group
#' @param color.heatmap A vector of two colors corresponding to max/min values, or a color name in brewer.pal only when the data in the heatmap do not contain negative values
#' @param title.name the name of the title
#' @param width width of heatmap
#' @param height height of heatmap
#' @param legend.title the title of the heatmap legend
#' @param width width of the heatmap bidy, should be a fixed `unit` object
#' @param height height of the heatmap body, should be a fixed `unit` object
#' @param font.size fontsize in heatmap
#' @param font.size.title font size of the title
#' @param cluster.rows whether cluster rows
Expand All @@ -1792,9 +1793,11 @@ netVisual_diffInteraction <- function(object, comparison = c(1,2), measure = c("
#' @importFrom ComplexHeatmap Heatmap HeatmapAnnotation anno_barplot rowAnnotation
#' @return an object of ComplexHeatmap
#' @export
netVisual_heatmap <- function(object, comparison = c(1,2), measure = c("count", "weight"), signaling = NULL, slot.name = c("netP", "net"), color.use = NULL, color.heatmap = c("#2166ac","#b2182b"),
title.name = NULL, width = NULL, height = NULL, font.size = 8, font.size.title = 10, cluster.rows = FALSE, cluster.cols = FALSE,
sources.use = NULL, targets.use = NULL, remove.isolate = FALSE, row.show = NULL, col.show = NULL){
netVisual_heatmap <- function(object, comparison = c(1,2), measure = c("count", "weight"), signaling = NULL,
slot.name = c("netP", "net"), color.use = NULL, color.heatmap = c("#2166ac","#b2182b"),
title.name = NULL, legend.title = NULL, width = NULL, height = NULL, font.size = 8, font.size.title = 10,
cluster.rows = FALSE, cluster.cols = FALSE, sources.use = NULL, targets.use = NULL,
remove.isolate = FALSE, row.show = NULL, col.show = NULL){
# obj1 <- object.list[[comparison[1]]]
# obj2 <- object.list[[comparison[2]]]
if (!is.null(measure)) {
Expand All @@ -1816,15 +1819,15 @@ netVisual_heatmap <- function(object, comparison = c(1,2), measure = c("count",
title.name = "Differential interaction strength"
}
}
legend.name = "Relative values"
if(is.null(legend.title)) legend.title <- "Relative values"
} else {
message("Do heatmap based on a single object \n")
if (!is.null(signaling)) {
net.diff <- slot(object, slot.name)$prob[,,signaling]
if (is.null(title.name)) {
title.name = paste0(signaling, " signaling network")
}
legend.name <- "Communication Prob."
if(is.null(legend.title)) legend.title <- "Communication Prob."
} else if (!is.null(measure)) {
net.diff <- object@net[[measure]]
if (measure == "count") {
Expand All @@ -1836,7 +1839,7 @@ netVisual_heatmap <- function(object, comparison = c(1,2), measure = c("count",
title.name = "Interaction strength"
}
}
legend.name <- title.name
if(is.null(legend.title)) legend.title <- title.name
}
}

Expand Down Expand Up @@ -1916,24 +1919,31 @@ netVisual_heatmap <- function(object, comparison = c(1,2), measure = c("count",
show_legend = FALSE, show_annotation_name = FALSE,
simple_anno_size = grid::unit(0.2, "cm"))

ha1 = rowAnnotation(Strength = anno_barplot(rowSums(abs(mat)), border = FALSE,gp = gpar(fill = color.use, col=color.use)), show_annotation_name = FALSE)
ha2 = HeatmapAnnotation(Strength = anno_barplot(colSums(abs(mat)), border = FALSE,gp = gpar(fill = color.use, col=color.use)), show_annotation_name = FALSE)
ha1 = rowAnnotation(Strength = anno_barplot(rowSums(abs(mat)), border = FALSE, gp = gpar(fill = color.use, col=color.use)),
show_annotation_name = FALSE)
ha2 = HeatmapAnnotation(Strength = anno_barplot(colSums(abs(mat)), border = FALSE,gp = gpar(fill = color.use, col=color.use)),
show_annotation_name = FALSE)

if (sum(abs(mat) > 0) == 1) {
color.heatmap.use = c("white", color.heatmap.use)
} else {
mat[mat == 0] <- NA
}
ht1 = Heatmap(mat, col = color.heatmap.use, na_col = "white", name = legend.name,

ht.name <- paste0(abbreviate(legend.title), sample(.Machine$integer.max, 1))

ht1 = Heatmap(mat, col = color.heatmap.use, na_col = "white", name = ht.name,
bottom_annotation = col_annotation, left_annotation =row_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.name,column_title_gp = gpar(fontsize = font.size.title),column_names_rot = 90,
row_title = "Sources (Sender)",row_title_gp = gpar(fontsize = font.size.title),row_title_rot = 90,
heatmap_legend_param = list(title_gp = gpar(fontsize = 8, fontface = "plain"),title_position = "leftcenter-rot",
border = NA, #at = colorbar.break,
legend_height = unit(20, "mm"),labels_gp = gpar(fontsize = 8),grid_width = unit(2, "mm"))
cluster_rows = cluster.rows, cluster_columns = cluster.rows,
row_names_side = "left", row_names_rot = 0, column_names_rot = 90, row_title_rot = 90,
row_names_gp = gpar(fontsize = font.size), column_names_gp = gpar(fontsize = font.size),
row_title = "Sources (Sender)", row_title_gp = gpar(fontsize = font.size.title),
column_title = title.name, column_title_gp = gpar(fontsize = font.size.title),
width = width, height = height,
heatmap_legend_param = list(title = legend.title, title_gp = gpar(fontsize = font.size, fontface = "plain"),
title_position = "leftcenter-rot", border = NA, #at = colorbar.break,
legend_height = unit(20, "mm"), labels_gp = gpar(fontsize = font.size),
grid_width = unit(2, "mm"))
)
# draw(ht1)
return(ht1)
Expand Down
7 changes: 5 additions & 2 deletions man/netVisual_heatmap.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

0 comments on commit e4b91fb

Please sign in to comment.