Multiple fill legends for each variable in heat map - r

Question

I have an input file file1.txt:
V1 V2 Score
rs4939134 SIFT 1
rs4939134 Polyphen2 0
rs4939134 MutationAssessor -1.75
rs151252290 SIFT 0.101
rs151252290 Polyphen2 0.128
rs151252290 MutationAssessor 1.735
rs12364724 SIFT 0
rs12364724 Polyphen2 0.926
rs12364724 MutationAssessor 1.75
rs34448143 SIFT 0.005
rs34448143 Polyphen2 0.194
rs34448143 MutationAssessor 0.205
rs115694714 SIFT 0.007
rs115694714 Polyphen2 1
rs115694714 MutationAssessor 0.895
And this is my R code to plot this table as a heatmap:
library(ggplot2)
mydata <- read.table("file7.txt", header = FALSE, sep = "\t")
names(mydata) <- c("V1", "V2", "Score")
ggplot(data = mydata, aes(x = V1, y = V2, fill = Score)) +
geom_tile() +
geom_text(aes(V1, V2, label = Score), color = "black", size = 3) +
scale_fill_continuous(type = "viridis", limits = c(-5.76, 5.37)) +
labs(x = "pic1", y = "") +
theme_bw()
theme(panel.border = element_rect(colour = "black"),
panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
axis.line = element_line(colour = "black"),
axis.text = element_text(size = 4))
And this the plot I got:
what I need is for each row (each type in V2) I need to put a legend that represented, so at the end there will be 3 legends, each represent (one for SIFT, second for Polyphen and the third for MutationAssessor) with different range that I can specify.
for example: SIFT from (0,1)
and Polyphen from (0,1)
and MutationAssessor from (-6,6)
I tried different thing of previous asked questions but nothing work with me.
I appreciate any help.

Answer 1

You can loop over three given variables and plot different plots for each of them. In the end you have to combine them.
Create dataset with wanted limits:
myLimits <- list(
list("SIFT", 0, 1),
list("Polyphen2", 0, 1),
list("MutationAssessor", -6, 6)
)
Function to plot heatmap only for one variable at a time:
plotHeat <- function(type, MIN, MAX) {
library(ggplot2)
p <- ggplot(subset(mydata, V2 == type),
aes(V1, V2, fill = Score, label = Score)) +
geom_tile() +
geom_text(color = "black", size = 3) +
scale_fill_continuous(type = "viridis", limits = c(MIN, MAX)) +
labs(x = "SNP",
y = NULL,
fill = type) +
theme_bw()
# Output x-axis only for the last plot
if (type != myLimits[[length(myLimits)]][[1]]) {
p <- p + theme(axis.text.x = element_blank(),
axis.title.x = element_blank(),
axis.line.x = element_blank(),
axis.ticks.x = element_blank())
}
return(p)
}
Plot and combine plots using egg package:
res <- lapply(myLimits, function(x) {plotHeat(x[[1]], x[[2]], x[[3]])})
egg::ggarrange(plots = res)

Answer 2

This is maybe related to this.
xs <- split(mydata, f = mydata$V2)
p1 <- ggplot(data = xs$MutationAssessor, aes(x = V1, y = 0, fill = Score)) +
geom_tile() +
geom_text(aes(label = Score), color = "black", size = 3) +
scale_fill_continuous(type = "viridis", limits = c(-5.76, 5.37)) +
labs(x = "pic1", y = "") +
facet_grid(V2 ~ .) +
theme_bw() +
theme(panel.border = element_rect(colour = "black"),
panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
axis.line = element_line(colour = "black"),
axis.text = element_text(size = 4))
p2 <- p1 %+% xs$Polyphen2
p3 <- p1 %+% xs$SIFT
library(gridExtra)
grid.arrange(p1, p2, p3)
And the result is:
EDIT:
In case you want different range for facets but you want values to be comparable (e.g. value around 5 should be yellow in all plots), there is a possible solution
First discretize your fill variable
mydata$colour <- cut(mydata$Score,
quantile(mydata$Score, c(0, 0.25, 0.5, 0.75, 1)),
include.lowest = T)
Then create plots:
xs <- split(mydata, f = mydata$V2)
p1 <- ggplot(data = xs$MutationAssessor, aes(x = V1, y = 0, fill = colour)) +
geom_tile() +
geom_text(aes(label = Score), color = "black", size = 3) +
labs(x = "pic1", y = "") +
facet_grid(V2 ~ .) +
theme_bw() +
theme(panel.border = element_rect(colour = "black"),
panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
axis.line = element_line(colour = "black"),
axis.text = element_text(size = 4))
p2 <- p1 %+% xs$Polyphen2
p3 <- p1 %+% xs$SIFT
And finally change palette:
mypalette <- c("#FFFFCC", "#A1DAB4", "#41B6C4", "#2C7FB8", "#253494")
names(mypalette) <- levels(mydata$colour)
p1 <- p1 + scale_fill_manual(values = mypalette[levels(xs$MutationAssessor$colour)])
p2 <- p2 + scale_fill_manual(values = mypalette[levels(xs$Polyphen2$colour)])
p3 <- p3 + scale_fill_manual(values = mypalette[levels(xs$SIFT$colour)])
And the result is:
grid.arrange(p1, p2, p3)