Heatmap with condition

Question

I work with some rnaseq data, and a need to plot a heatmap with dots at determined transcripts of genes. I can not figure out how to this with ggpplot or pheatmap. So I have to use inkscape to manually put every dot on the plot. It's exausting, and a waste of time. Bellow is the image from inkscape:

I've made the basic plot with this code:

pal <- colorRampPalette(c("blue","white","red"))
a<-pal(200)
my_sample_col <- data.frame(Condition = 
c("ALZxCon","PAxCon","PSPxCon"))
rownames(my_sample_col)<- colnames(transcript.table[,1:3])
my_colour <- list(Condition = c(ALZxCon = "lightblue",PAxCon = 
"pink",PSPxCon = "yellow"))

pheatmap(transcript.table[,1:3],annotation_col = 
my_sample_col,annotation_colors = my_colour[1],
color=a,show_colnames = F,cellheight = 15,cex=1,cluster_rows = 
F,cluster_cols = F,
fontsize_row = 10,gaps_col = c(1,2),cellwidth = 15)

Where transcript table is something like this:

                         log2FC(AZ)  log2FC(PA)  log2FC(PSP)  Sig(AZ)  Sig(PA)  Sig(PSP)
ABCA7_ENST000002633094    -0.2        -0.3       -0.2         Not Sig  FDR<0.05  FDR<0.05
ABCA7_ENST0000043319      -0.6        -0.37      -0.7         FDR<0.05 FDR<0.05  FDR<0.05

I want to generate a heatmap where the square of the transcripts with FDR < 0.05 gets a black dot. Can you guys help with this?

Answer 1

I'm personally not an enormous fan of functions such as pheatmap, precisely because you can't customise every detail you would want. I'll show an alternative with ggplot2.

First things first, ggplot likes data in a long format, which I would do as follows:

# Loading in your data
z <- "log2FC(AZ),log2FC(PA),log2FC(PSP),Sig(AZ),Sig(PA),Sig(PSP)
ABCA7_ENST000002633094,-0.2,-0.3,-0.2,Not Sig,FDR<0.05,FDR<0.05
ABCA7_ENST0000043319,-0.6,-0.37,-0.7,FDR<0.05,FDR<0.05,FDR<0.05"
tab <- read.table(text=z, header = T, sep = ",")

# Converting to long format
lfc <- tab[,1:3]
pval <- tab[,4:6]
colnames(lfc) <- colnames(pval) <- c("AZ", "PA", "PSP")

lfc  <- reshape2::melt(as.matrix(lfc))
pval <- reshape2::melt(as.matrix(pval))

df <- cbind(lfc, pval = pval$value)

Which will get us our main ingredients for the heatmap and the significance dots, but we would need a little extra data.frame for some annotation:

anno <- data.frame(x = levels(df$Var2),
                   y = "Condition")

Now the trick in getting this annotation to work nicely with the heatmap is a package called ggnewscale, which will allow us to set both a continuous fill for the heatmap and a discrete fill for the annotation. What remains is to make the actual plot, wherein I've tried to conserve some aspects of the pheatmap function in your example.

library(ggnewscale)

ggplot(df, aes(Var2, Var1)) +
  # Important for ggnewscale is to specify a fill in the layer/geom itself
  geom_tile(aes(fill = value),
            width = 0.9, colour = "grey50") +
  geom_point(data = df[df$pval == "FDR<0.05",]) +
  scale_fill_gradientn(colours = c("blue", "white", "red"),
                       limits = c(-1,1)*max(abs(df$value)),
                       name = expression(atop("Log"[2]*" Fold","Change"))) +
  # Set new scale fill after you've specified the scale for the heatmap
  new_scale_fill() +
  geom_tile(data = anno, aes(x, y, fill = x),
            width = 0.9, height = 0.8, colour = "grey50") +
  scale_fill_discrete(name = "Condition") +
  scale_x_discrete(name = "", expand = c(0,0)) +
  scale_y_discrete(name = "", expand = c(0,0),
                   limits = c(levels(df$Var1), "Condition"),
                   position = "right") +
  coord_equal() +
  theme(panel.background = element_blank(),
        axis.ticks = element_blank(),
        axis.text.x = element_blank(),
        axis.text.y = element_text(face = c(rep("plain", nlevels(df$Var1)), "bold")))

Which looks like this:

Mix and match the ggplot code as you please.