Question: Hi all,

I came through a heatmap of CNVs from Illumina Genome Studio which has four samples (see attachment). On Y axis they have genomic coordinates and on X axis the samples. Red denotes amplification and blue denotes deletion. I was wondering how can we make similar heatmap in R for CNV data or expression data? I know a little basis of ggplot and ggbio but I don't know how to make heatmap with genomic coordinates on Y axis. There are fix length of each chromosomes defined say chr-1 is 250 million base-pairs (units), chr-2 is 240 M, chr-3 is 200 M etc. Now there are segments of copy number changes with start position and end position for which heatmap is to be made. Now for chr-1 of size proportional to 250M, we need red block at location proportional to base pair 23432-to-25925 and another red block at 34564-to-44572 etc... similarly for each chromosome.

CNV data is in segments:

chr start end copy-number-T1 copy-number-T2

chr1 23432 25925 4 3

chr1 34564 44572 5 5

chr1 78463 85634 3 4

chr2 1375364 1378364 1 2

chr2 1463723 1469367 4 6

chr2 1678573 1683642 2 5

etc....

Thanks in advance.

Answer: I can help with something like this, but I don't know how to prettify the Y axis labels - all chromosomes in my example are of length 20, so labels are getting overcrowded and I disabled them.

-- edit: fixed labels

require(ggplot2)
require(reshape)

data <- data.frame(matrix(rnorm(2*20*4)-0.5, nrow=2*20, byrow=F))
names(data) <- paste("T",1:4,sep="")
data$chromosome=factor(1:(2*20),1:(2*20),
labels=paste(rep(paste("chr",1:2,sep=""),each=20),1:20,sep="."))
data$labels=matrix(rbind(paste("chr",1:2,sep=""),
matrix(rep("",19*2),nrow=19)),byrow=T,nrow=20*2)

dm <- melt(data,id.var=c("chromosome","labels"))

dm$fill <- rep("white",2*20*4)
dm$fill[dm$value < -0.5] <- "red"
dm$fill[dm$value > 0.5] <- "blue"

p <- ggplot(dm, aes(variable, chromosome, fill=fill)) + geom_tile()
p + scale_fill_identity(expand=c(0,0),guide = "legend",
labels=c("deletion","amplification","none")) +
scale_y_discrete(breaks=dm$chromosome,labels=dm$labels) +
ggtitle("Example for 2 chromosomes")

-- edit2, with your data, just changed two values to negatives:

require(ggplot2)
require(reshape)

# four samples, here genome is linear, 2M long, each bin is 1000bp
# matrix rows = bins, matrix columns = samples
data <- matrix(rep(rep(0,2000000/1000),4),ncol=4)

# the intervals from your sample
intervals=data.frame(chromosome=c("chr1","chr1","chr1","chr2","chr2","chr2"),
start=c(23432,34564,78463,1375364,1463723,1678573),
end=c(25925,44572,85634,1378364,1469367,1683642),
t1=c(4,5,3,-1,4,2),
t2=c(3,5,4,2,-6,5))

# transfer the values from data frame into the matrix, probably can code a single function
mark_t1 <- function(a,b,c){ data[ (a/1000) : (b/1000), 1] <<- c}
apply(intervals[,c('start','end','t1')], 1 , function(x) mark_t1(x[1],x[2],x[3]))

mark_t2 <- function(a,b,c){ data[ (a/1000) : (b/1000), 2] <<- c}
apply(intervals[,c('start','end','t2')], 1 , function(x) mark_t2(x[1],x[2],x[3]))

# converting the matrix into a data frame
data <- as.data.frame(data)
names(data) <- paste("T",1:4,sep="")

# add bins column
data$bin=seq(1,2000000,by=1000)
dm <- melt(data,id.var=c("bin"))

# color the bins according to their values
dm$fill <- "white"
dm$fill[dm$value < -0.5] <- "red"
dm$fill[dm$value > 0.5] <- "blue"

# plot as red-white-blue rectangles, by using bins and continuous scale, it's easy to
# place Chromosome or even Gene markers
#
p <- ggplot(dm, aes(variable, bin, fill=fill)) + geom_tile()
p + scale_fill_identity(expand=c(0,0),guide = "legend",
labels=c("amplification","deletion","none")) +
scale_y_continuous(breaks=c(0,1400000,2000000),labels=c("Chr 1","Chr 2","Chr 3")) +
ggtitle("Example for 2 chromosomes") +
theme_bw() +
theme(panel.grid.major = element_blank(),panel.grid.minor = element_blank(),
panel.border = element_blank(),panel.background = element_blank(),
axis.title.x= element_blank(),axis.title.y = element_blank())

or just like a heatmap plot:

#plot as white-to-blue heatmap
p2 <- ggplot(dm, aes(variable, bin, fill=value)) + geom_tile()
p2 + scale_y_continuous(breaks=c(0,1400000,2000000),labels=c("Chr 1","Chr 2","Chr 3")) +
scale_fill_gradient(low = "white", high = "steelblue") +
theme_bw() + ggtitle("Example for 2 chromosomes") +
theme(panel.grid.major = element_blank(),panel.grid.minor = element_blank(),
panel.border = element_blank(),panel.background = element_blank(),
axis.title.x= element_blank(),axis.title.y = element_blank())