Gallery: CPC-GENE Multiplot, Scatterplot, and Heatmaps

### PREAMBLE #######################################################################################
library(BoutrosLab.plotting.general)
 
# Read Data
plot.data <- read.csv(file = 'subtype_comparison_expected_scatterplot.csv', row.names = 1);
expected.heatmap.data <- t(plot.data[,1:4]);
actual.heatmap.data <- t(plot.data[,5:8]);
p.val.heatmap.data <- t(plot.data[,9:12]);
min.co.class.p.val.heatmap.data <-t(plot.data[,13:16]);
min.mut.ex.p.val.heatmap.data <- t(plot.data[,17:20]);
col.lines1 <- (plot.data[,21])[!is.na(plot.data[,21])];
col.lines2 <- (plot.data[,22])[!is.na(plot.data[,22])];
connecting.scatterplot.data <- (plot.data[,23:25])[complete.cases(plot.data[,23:25]),];
 
# Subtype colours
subtype.colours <- c('plum1', 'sienna', 'darkslategrey', 'seagreen3', 'slateblue4', 'orange',
                     'chartreuse4', 'darkorchid4', 'gold', 'dodgerblue', '#336A90', '#65B4A2',
                     '#B1D39A', '#F4E0A6', 'olivedrab2', 'olivedrab4', 'thistle1', 'thistle3');
data.types <- c('mrna_abundance','snvs_binned_1e+05bp_sliding','breakpoints_recurrent','oscna_new_v3');
labels <- c('CNA', 'Breakpoints', 'SNV', 'mRNA Abundance');
 
### CREATE PLOTS ##################################################################################
 
# heatmap showing the proportion of patients expected to be classified in each set of clusters
expected.heatmap <- create.heatmap(
	x = expected.heatmap.data,
	same.as.matrix=TRUE,
	colour.scheme = c('white', subtype.colours),
	cluster.dimensions = 'none',
	yaxis.cex=1,
	yaxis.lab=NULL,
	xaxis.lab=NULL,
	width= 7.5,
	height=1.125*length(data.types),
	at = seq(-0.5,19.5,1),
	print.colour.key=FALSE,
	grid.col=FALSE,
	col.lines=col.lines1
	);
 
# heatmap showing the actual classification of patients
actual.heatmap <- create.heatmap(
	x=actual.heatmap.data,
	same.as.matrix=TRUE,
	colour.scheme = c('white', subtype.colours),
        cluster.dimensions = 'none',
	yaxis.cex=1,
	width= 7.5,
	height=1.125*length(data.types),
	at = seq(-0.5,19.5,1),
	print.colour.key=FALSE,
	grid.col=FALSE,
	col.lines=col.lines2,
	yat=seq(0,5,0.5),
	yaxis.lab=seq(0,5,0.5)
	);
 
 
# heatmap showing the p-value for a proportion test between the expected and observed proportions
p.val.heatmap <- create.heatmap(
	x=p.val.heatmap.data,
	same.as.matrix=TRUE,
	colour.scheme = c('black','white'),
	cluster.dimensions = 'none',
	yaxis.cex=1,
	yaxis.lab=,
	width= 7.5,
	height=1.125*length(data.types),
	at = c(0,0.0001,0.01,0.05,0.2,1),
	colourkey.cex = 1,
	colourkey.labels.at = c(0,0.05,0.2,0.5,1),
	grid.col=TRUE,
	col.lines=col.lines2
	);
 
# heatmap showing the smallest possible p-values if the set of clusters are co-classifying patients
# i.e. the number of patients will be the smallest number of patients from each of the different classifications
min.co.class.p.val.heatmap <- create.heatmap(
	x=min.co.class.p.val.heatmap.data,
	same.as.matrix=TRUE,
	colour.scheme = c('black','white'),
	cluster.dimensions = 'none',
	yaxis.cex=1,
	yaxis.lab=labels,
	width= 7.5,
	height=1.125*length(data.types),
	at = c(0,0.0001,0.01,0.05,0.2,1),
	colourkey.cex = 1,
	colourkey.labels.at = c(0,0.05,0.2,0.5,1),
	grid.col=TRUE,
	col.lines=col.lines2
	);
 
# heatmap showing the smallest possible p-values if the set of clusters are mutually exclusive
# i.e. the number of patients with the classifications is zero
min.mut.ex.p.val.heatmap <- create.heatmap(
	x = min.mut.ex.p.val.heatmap.data,
	same.as.matrix=TRUE,
	colour.scheme = c('black','white'),
	cluster.dimensions = 'none',
	yaxis.cex=1,
	yaxis.lab=labels,
	width= 7.5,
	height=1.125*length(data.types),
	at = c(0,0.0001,0.01,0.05,0.2,1),
	colourkey.cex = 1,
	colourkey.labels.at = c(0,0.05,0.2,0.5,1),
	grid.col=TRUE,
	col.lines=col.lines2
	);
 
#scatterplot to connect heatmaps
connecting.scatterplot <- create.scatterplot(
    y~x,
    data.frame(
        y=connecting.scatterplot.data[,1],
        x=connecting.scatterplot.data[,2]
        ),
    type='l',
    groups=connecting.scatterplot.data[,3],
    height=2,
    xat=NULL,
    yat=NULL,
    xlimits=c(0,1380.5),
    ylimits=c(0.5,4.5)
    );
 
# create legends
legend <- list(
    legend=list(
        colours=subtype.colours[1:5],
        labels=paste('cluster',1:5),
        title=labels[4]
        ),
    legend=list(
        colours=subtype.colours[6:10],
        labels=paste('cluster',1:5),
        title=labels[3]
        ),
    legend=list(
        colours=subtype.colours[11:14],
        labels=paste('cluster',1:4),
        title=labels[2]
        ),
    legend=list(
        colours=subtype.colours[15:18],
        labels=paste('cluster',1:4),
        title=labels[1]
        ),
    legend=list(
	colours=c('#FFFFFF', '#BFBFBF', '#7F7F7F', '#3F3F3F','#000000'),
	labels=c(
		'0.2 to 1',
		'0.05 to 0.2',
		'0.01 to 0.05',
		'1e-4 to 0.01',
		'0 to 1e-4'
		),
	title='p-values'
	)
);
 
p.value.label <- list(
	legend=list(
		labels=expression(bold('prop.test\n  p-value')),
		colours='transparent',
		border='transparent',
		labl.cex=0.1
		)
	);
co.class.note <- list(
	legend=list(
		labels=expression(bold('min possible p-value\nif co-classifying')),
		colours='transparent',
		border='transparent'
		)
	);
 mut.ex.note <- list(
	legend=list(
		labels=expression(bold('min possible p-value\nif mutually exclusive')),
		colours='transparent',
		border='transparent'
		)
	);
 
# create multiplot
create.multiplot(
	list(min.co.class.p.val.heatmap,
        min.mut.ex.p.val.heatmap,
        p.val.heatmap,actual.heatmap,
        connecting.scatterplot,expected.heatmap
        ),
	filename='subtype_comparison_expected_scatterplot_BPG.tiff',
	panel.heights=c(8,2,8,1,1,1,1,1),
	xat=NULL,
	yat=NULL,
	y.spacing=0,
	ylimits=c(0.5, 4.5),
	xlimits=c(0.5,1380.5),
	legend=list(
		right=list(fun=legend.grob(legend,title.just='left')),
		inside=list(
			fun=legend.grob(p.value.label),
			x=-0.12,
			y=0.15
			),
		inside=list(
			fun=legend.grob(co.class.note,label.cex=0.55),
			x=-0.14,
			y=0.02
			),
		inside=list(
			fun=legend.grob(mut.ex.note,label.cex=0.55),
			x=-0.14,
			y=0.07
			)
		),
	print.new.legend=TRUE,
	width=12,
        resolution=1200,
	plot.layout=c(1,8),
	yaxis.cex=0.5,
	ylab.padding=8,
	xlab.padding=0,
	key.bottom.padding=0,
	xlab.to.xaxis.padding=0,
	bottom.padding=2.2,
	layout.skip=c(FALSE,FALSE,TRUE,FALSE,TRUE,FALSE,FALSE,FALSE)
	);

Created by Pretty R at inside-R.org