From 89094124d9cb35e7f14e37edf770cd80197480c0 Mon Sep 17 00:00:00 2001 From: jenzopr Date: Wed, 5 Aug 2015 09:14:31 +0200 Subject: [PATCH] Added heatmap for large sample numbers --- src/meth_plot.R | 73 ++++++++++++------------------------ src/renderAdditionalImages.R | 17 ++++++--- 2 files changed, 36 insertions(+), 54 deletions(-) diff --git a/src/meth_plot.R b/src/meth_plot.R index 6b59905..4f7d75c 100755 --- a/src/meth_plot.R +++ b/src/meth_plot.R @@ -49,25 +49,6 @@ meth_plot <- function(dd, intervals, SampleOrder, plotType, position, grup, posl if(dim(dd)[2]>maxCpG) stop(paste0("plot type circles only allows a maximum of ", maxCpG," positions.")) if(dim(dd)[1]>maxSamples) stop(paste0("plot type circles only allows a maximum of ", maxSamples," samples.")) - colores <- function(x){ - grisos <- rev(brewer.pal((dim(intervals)[1]),"RdBu")) - if(x>=intervals[1,1] & x<=intervals[1,2] & !is.na(x)) colorin <- "#FFFFFF" - for(k in 2:(dim(intervals)[1]-1)){ - if(x>=intervals[k,1] & x<=intervals[k,2] & !is.na(x)) colorin <- grisos[k-1] - } - if(x>=intervals[dim(intervals)[1],1] & x<=intervals[dim(intervals)[1],2] | is.na(x)) colorin <- "#000000" - return(colorin) - } - color_legend<-c("#FFFFFF",rev(gray.colors((dim(intervals)[1]-2))),"#000000") - - - - formas <- function(x){ - if(is.na(x)) forma <- 4 - if(!is.na(x)) forma <- 21 - return(forma) - } - ################################################################################################# ################################################################################################# @@ -101,57 +82,53 @@ meth_plot <- function(dd, intervals, SampleOrder, plotType, position, grup, posl ################################################################################################# if(plotType=="nonproportional"){ - xmax <- dim(dd)[2]+((dim(dd)[2]-1)/2) + xmax <- dim(dd)[2]#+((dim(dd)[2]-1)/2) xmin <- 1 ymax <- dim(dd)[1] - colplot <- colores(dd[1,1]) - formplot <- formas(dd[1,1]) par(mai=par()$mai+c(0.5,1,0,0)) - plot(1, 1, pch=formplot, col="black", bg=colplot, cex=2, xlim=c(xmin,xmax), ylim=c(1,ymax), axes=FALSE, xlab="", ylab="") - axis(1, at=c(1:dim(dd)[2]), labels=paste0(position), las=2, srt=45) - axis(2, at=c(1:ymax), rownames(dd)[1:(dim(dd)[1])], las=1) + plot(1, type="n", xlim=c(xmin,xmax), ylim=c(1,ymax), axes=FALSE, xlab="", ylab="") + axis(1, at=c(1:dim(dd)[2]), labels=paste0(position), las=2, srt=45, lwd=0, line=-1) + axis(2, at=c(1:ymax), rownames(dd)[1:(dim(dd)[1])], las=1, lwd=0) + axis(3, at=c(xmin,xmax), labels=c("",""), lwd.ticks=0) + axis(3, at=c(1:dim(dd)[2]), labels=paste0(position), srt=45, lwd=1) abline(h=c(1:ymax), lty=1, col="dimgray") + palette = rev(brewer.pal((dim(intervals)[1]),"RdBu")) + for(j in 1:dim(dd)[1]){ - for(i in 1:dim(dd)[2]){ - colplot <- colores(dd[j,i]) - formplot <- formas(dd[j,i]) - points(i, j, pch=formplot, col="black", bg=colplot, cex=2) - } + i = 1:dim(dd)[2] + colplot = palette[as.numeric(cut(c(0,1,dd[j,i]),breaks=dim(intervals)[1]))[c(-1,-2)]] + formplot = ifelse(is.na(dd[j,i]),4,21) + points(i, rep(j, times=length(i)), pch=formplot, col="black", bg=colplot, cex=2) } - legend("right", c(paste0(intervals[,1],"-",intervals[,2]),"Not available"), fill=NULL, border="white", bty="o", pt.cex=1.5, pch=c(rep(21,dim(intervals)[1]),4), pt.bg=c("#FFFFFF",rev(gray.colors((dim(intervals)[1]-2))),"#000000"),bg="white") - box(lwd=2) + #legend("right", c(paste0(intervals[,1],"-",intervals[,2]),"Not available"), fill=NULL, border="white", bty="o", pt.cex=1.5, pch=c(rep(21,dim(intervals)[1]),4), pt.bg=c("#FFFFFF",rev(gray.colors((dim(intervals)[1]-2))),"#000000"),bg="white") + #box(lwd=2) par(mai=par()$mai+c(-0.5,-1,0,0)) } } - - ################################################################################################# ################################################################################################# + if(plotType == "grid"){ - dd2 <- dd#[dim(dd)[1]:1,] - dd2[which(is.na(dd2))] <- -0.1 - # qwe <- as.vector(col2rgb("lightblue")) - # rgb(173,216,230, maxColorValue=255) library(lattice) - # library(latticeExtra) - if(dim(dd2)[1]<=dim(intervals)[1]) legendheight <- 1 - if(dim(dd2)[1]>dim(intervals)[1]) legendheight <- dim(intervals)[1]/dim(dd2)[1] - colkey <- c("#ADD8E6","#FFFFFF",rev(gray.colors((dim(intervals)[1]-2))),"#000000") + if(dim(dd)[1]<=dim(intervals)[1]) legendheight <- 1 + if(dim(dd)[1]>dim(intervals)[1]) legendheight <- dim(intervals)[1]/dim(dd)[1] + colkey = rev(brewer.pal((dim(intervals)[1]),"RdBu")) cuts <- c(intervals[1,1],intervals[1:(dim(intervals)[1]-1),2])-0.000001 cutfinal<-intervals[dim(intervals)[1],2] - print(obj1 <- levelplot(t(dd2), at=c(-0.1,cuts,cutfinal), col.regions=colkey, xlab="", ylab="", - colorkey=list(height=legendheight, width=1, at=c(-0.1,c(cuts+0.000001,cutfinal)), - labels=c("NA",paste0(c(cuts+0.000001,cutfinal))), - col=colkey), - scales=list(y=list(labels=paste(grup)), tck=c(1,0), - x=list(labels=poslabel, rot=90)), border="black")) + print(obj1 <- levelplot(t(dd[,order(probePositions)]), at=c(0,intervals[,2]),col.regions=colkey, xlab="", ylab="", + scales=list(y=list(labels=paste(grup)), + tck=c(1,0), + x=list(labels=poslabel, rot=90)), + border="black" + ) + ) } } diff --git a/src/renderAdditionalImages.R b/src/renderAdditionalImages.R index 54f434b..7229def 100755 --- a/src/renderAdditionalImages.R +++ b/src/renderAdditionalImages.R @@ -21,12 +21,17 @@ for(i in 1:nrow(driver)) { betaValues = t(betaValues) rownames(betaValues) = sampleInfo[groupSamples,"Sample_Group"] - pdf(file=paste(dirname(driver[i,"file"]),"/",driver[i,"chr"],"-",min(probePositions),"-",max(probePositions),".pdf",sep="")) - meth_plot(betaValues,intervals,"by-meth","proportional",probePositions,row.names(betaValues),probeNames) - dev.off() - #pdf(file=paste(dirname(driver[i,"file"]),"/hm-",driver[i,"chr"],"-",min(probePositions),"-",max(probePositions),".pdf",sep="")) - #meth_plot(betaValues,intervals,"by-meth","grid",probePositions,row.names(betaValues),probeNames) - #dev.off() + if(nrow(betaValues) <= 30) { + pdf(file=paste(dirname(driver[i,"file"]),"/",driver[i,"chr"],"-",min(probePositions),"-",max(probePositions),".pdf",sep="")) + meth_plot(betaValues,intervals,"by-meth","proportional",probePositions,row.names(betaValues),probeNames) + dev.off() + } + else { + pdf(file=paste(dirname(driver[i,"file"]),"/",driver[i,"chr"],"-",min(probePositions),"-",max(probePositions),".pdf",sep="")) + meth_plot(betaValues,intervals,"by-meth","grid",probePositions,row.names(betaValues),probeNames) + dev.off() + } + unlink(paste(driver[i,"file"],"txt",sep=".")) }