Skip to content

Commit

Permalink
Browse files Browse the repository at this point in the history
Added heatmap for large sample numbers
  • Loading branch information
@jenzopr
jenzopr committed Aug 5, 2015
1 parent 5bf0bf3 commit 8909412
Show file tree
Hide file tree
Showing 2 changed files with 36 additions and 54 deletions.
73 changes: 25 additions & 48 deletions src/meth_plot.R
View file
Expand Up @@ -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)
}

#################################################################################################
#################################################################################################

Expand Down Expand Up @@ -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"
)
)
}

}
17 changes: 11 additions & 6 deletions src/renderAdditionalImages.R
View file
Expand Up @@ -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="."))
}

0 comments on commit 8909412

Please sign in to comment.