vignettes/articles/lipid_regulatory_proteins_heatmap.Rmd
lipid_regulatory_proteins_heatmap.RmdThis article generates a heatmap of lipid regulatory proteins (Fig. 5D).
library(MotrpacRatTraining6moWATData)
library(Biobase)
#> Loading required package: BiocGenerics
#>
#> Attaching package: 'BiocGenerics'
#> The following objects are masked from 'package:stats':
#>
#> IQR, mad, sd, var, xtabs
#> The following objects are masked from 'package:base':
#>
#> anyDuplicated, aperm, append, as.data.frame, basename, cbind,
#> colnames, dirname, do.call, duplicated, eval, evalq, Filter, Find,
#> get, grep, grepl, intersect, is.unsorted, lapply, Map, mapply,
#> match, mget, order, paste, pmax, pmax.int, pmin, pmin.int,
#> Position, rank, rbind, Reduce, rownames, sapply, setdiff, table,
#> tapply, union, unique, unsplit, which.max, which.min
#> Welcome to Bioconductor
#>
#> Vignettes contain introductory material; view with
#> 'browseVignettes()'. To cite Bioconductor, see
#> 'citation("Biobase")', and for packages 'citation("pkgname")'.
library(dplyr)
#>
#> Attaching package: 'dplyr'
#> The following object is masked from 'package:Biobase':
#>
#> combine
#> The following objects are masked from 'package:BiocGenerics':
#>
#> combine, intersect, setdiff, union
#> The following objects are masked from 'package:stats':
#>
#> filter, lag
#> The following objects are masked from 'package:base':
#>
#> intersect, setdiff, setequal, union
library(tidyr)
library(ComplexHeatmap)
#> Loading required package: grid
#> ========================================
#> ComplexHeatmap version 2.20.0
#> Bioconductor page: http://bioconductor.org/packages/ComplexHeatmap/
#> Github page: https://github.com/jokergoo/ComplexHeatmap
#> Documentation: http://jokergoo.github.io/ComplexHeatmap-reference
#>
#> If you use it in published research, please cite either one:
#> - Gu, Z. Complex Heatmap Visualization. iMeta 2022.
#> - Gu, Z. Complex heatmaps reveal patterns and correlations in multidimensional
#> genomic data. Bioinformatics 2016.
#>
#>
#> The new InteractiveComplexHeatmap package can directly export static
#> complex heatmaps into an interactive Shiny app with zero effort. Have a try!
#>
#> This message can be suppressed by:
#> suppressPackageStartupMessages(library(ComplexHeatmap))
#> ========================================
save_plots <- dir.exists(paths = file.path("..", "..", "plots"))
# Proteins to plot
proteins <- c("Acaca", "Cpt1a", "Slc25a20", "Rab18", "Abcd3",
"Hacl1", "Abcd1", "Abcd3", "Dgat1", "Dgat2",
"Pck1", "Pck2", "Spast", "Pex11b", "Plin1", "Plin2",
# From https://rupress.org/view-large/figure/6879897/JCB_201311051_Fig2.jpeg
"Acsl1", "Acsl5", paste0("Agpat", 1:5), "Gpat3", "Gpat4")
# Isoform handling
PROT_EXP <- PROT_EXP[fData(PROT_EXP)[["gene_symbol"]] %in% proteins &
featureNames(PROT_EXP) != "XP_008762000.1", ]
mat <- pData(PROT_EXP) %>%
select(sex, timepoint) %>%
cbind(t(exprs(PROT_EXP))) %>%
pivot_longer(cols = -c(sex, timepoint),
names_to = "protein") %>%
mutate(protein = fData(PROT_EXP)[protein, "gene_symbol"],
protein = protein) %>%
filter(!is.na(value)) %>%
group_by(protein) %>%
mutate(value = scale(value)) %>%
group_by(sex, timepoint, protein) %>%
summarise(mean_val = mean(value), .groups = "keep") %>%
pivot_wider(id_cols = c(sex, timepoint),
values_from = mean_val,
names_from = protein) %>%
as.data.frame() %>%
`rownames<-`(with(., interaction(sex, timepoint))) %>%
select(-c(sex, timepoint)) %>%
t() %>%
as.matrix()
## Create heatmap ----
scale <- 2
ha <- pData(PROT_EXP) %>%
distinct(sex, timepoint) %>%
arrange(sex, timepoint) %>%
dplyr::rename(Sex = sex, Timepoint = timepoint) %>%
HeatmapAnnotation(
df = .,
border = TRUE,
gp = gpar(col = "black"),
gap = 0,
which = "column",
height = unit(6 * 2, "pt")*scale,
col = list(
Sex = c("Female" = "#ff6eff", "Male" = "#5555ff"),
Timepoint = c('SED' = 'white',
'1W' = '#F7FCB9',
'2W' = '#ADDD8E',
'4W' = '#238443',
'8W' = '#002612')
),
annotation_name_gp = gpar(fontsize = 7 * scale),
annotation_legend_param = list(Timepoint = list(
at = c("SED", "1W", "2W", "4W", "8W")),
border = "black",
labels_gp = gpar(fontsize = 6.5 * scale),
title_gp = gpar(fontsize = 7 * scale, fontface = "bold")
)
)
ht <- mat %>%
Heatmap(matrix = .,
col = circlize::colorRamp2(
breaks = c(-1.6, 0, 1.8),
colors = c("#3366ff", "white", "darkred")
),
cluster_columns = FALSE,
show_column_names = FALSE,
clustering_distance_rows = "pearson",
top_annotation = ha,
border = "black",
row_names_gp = gpar(fontsize = 5 * scale),
height = nrow(.) * unit(5.5, "pt") * scale,
width = ncol(.) * unit(5.5, "pt") * scale,
column_split = rep(1:2, each = 5),
column_title = NULL,
heatmap_legend_param = list(
title = "Mean\nZ-Score",
at = c(-1.6, -1:1, 1.8),
title_gp = gpar(fontsize = 7 * scale,
fontface = "bold"),
labels_gp = gpar(fontsize = 6 * scale),
legend_height = 5 * scale * unit(8, "pt"),
border = "black"
))