# TODO: Add comment # # Author: E.Korsching Jan 17, 2012 ############################################################################### color.matrix.perm <- function(x, col.range="cgh", mincolval=NULL, maxcolval=NULL, reset.col=F, text="", legend.text="correlation", cex=0.7){ # x: data.frame with values, color spread according to data or set mincolval / maxcolval # create a heat map type matrix reflecting the order of the permutation data # reset.col=T: if afterwards a 'save to PDF' is performed, the default palette colors will be used, not the chosen one #ini nr <- nrow(x) nc <- ncol(x) n.r <- row.names(x) n.c <- names(x) minT <- 1 maxT <- 16 if(is.null(mincolval)){ minS <- min(x) }else{ minS <- mincolval } #e.g. cor: mincolval= -1 if(is.null(maxcolval)){ maxS <- max(x) }else{ maxS <- maxcolval } #e.g. cor: maxcolval= 1 # save graphical parameters oldpar <- par(no.readonly=TRUE) # layout layout( matrix(c(1,2,3,3), nrow=2, ncol=2, byrow=TRUE), widths=c(5,18), #relative proportions, absolute scale might cause problems: c(lcm(5),lcm(5),lcm(5)) heights=c(24,2), respect=TRUE ) # layout.show(3) #function to check the layout # left layout area first: plot color bar color.set(color=col.range) par(mar=c(0.1,0.1,0.1,0.1)) #margins around plot area plot(x=0,y=0, xlim=c(0,3), ylim=c(minT-1,maxT+1), type="n", axes="F", xlab="", ylab="") #plot for(i in minT:maxT){ plot.bar.point.segment(x=1, height=1, width=1, col=i, density=-1, horiz=F, at=i, lwd=0.1, type="bar") } #annotate text(x=2,y=c(minT+0.5,maxT+0.5), labels=c(paste(round(minS,1),sep=""), paste(round(maxS,1),sep="")), adj=0, cex=cex+0.8, srt=0) text(x=2.4,y=(maxT/2)+0.5, labels=legend.text, adj=0.5, cex=cex+1.4, srt=90) # right layout area: plot color matrix par(mar=c(0.1,8,6,0.1)) #margins around plot area plot(0, 0, xlim=c(0.5,nc+0.5), ylim=c(0.5,nr+2.5), type="n", axes=F, xlab="", ylab="") for(i in 1:nc){ for(j in 1:nr){ c.v <- adaptScale(x[j,i],minS=minS,maxS=maxS,minT=minT,maxT=maxT) # calculate color value [1..16] col <- round(c.v, digits=0) # produce an integer plot.bar.point.segment(x=i,height=1,width=1,col=col,density=-1,horiz=F,at=nr+0.5-j,lwd=0.1,type="bar") } } usr <- par()$usr #get area coordinates if(is.null(n.r)){ axis(side=2, labels=T, tick=F, line=0, las=2, padj=0, outer=F) }else{ axis(side=2, at=c(nr:1), labels=n.r, tick=F, cex.axis=cex+0.5, line=0, las=2, padj=0, outer=F) } if(is.null(n.c)){ axis(side=3, labels=T, tick=F, line=0, outer=F, las=2, padj=1) }else{ text(x=c(1:nc),y=usr[4]-2, labels=n.c, adj=0, cex=cex+0.5, srt=45) # axis(side=3, at=c(1:nc), labels=n.c, tick=F, line=0, outer=F, las=2, padj=1) } # test plot in lower area par(mar=c(0.1,0.1,0.1,0.1)) #small margins around each plot area plot(0, 0, xlim=c(0,20), ylim=c(0,2), type="n", axes=F, xlab="", ylab="") text(x=0.1, y=0.5, labels=text, adj=0, cex=cex+1, col=NULL, font=2, family="sans", srt=0) #reset graphical parameters par(oldpar) #reset color scheme if necessary if(reset.col){ color.set(color="default") } # return(x) } #pdf(file=paste(getwd(),"/results/dove.color.mat1",".",format(Sys.time(), "%Y%m%d%H%M"),".pdf", sep=""), # width=11, height=7, onefile=T, title="perm.rk.male.female", pointsize=12) #color.matrix.perm(x=as.data.frame(He589.c.dist[[3]][He589.c.min.max.o[1,],]), col.range="cgh", # mincolval=NULL, maxcolval=NULL, reset.col=F, text="", legend.text="correlation", cex=0.7) #worst order #mtext(text=paste("best order (min), ",round(max(He589.c.dist[[1]][,1]),2)," -> ",round(min(He589.c.dist[[1]][,1]),2),sep=""), line=3,side=1,srt=0) #color.matrix.perm(x=as.data.frame(He589.c.dist[[3]][He589.c.min.max.o[2,],]), col.range="cgh", # mincolval=NULL, maxcolval=NULL, reset.col=F, text="", legend.text="correlation", cex=0.7) #best order #mtext(text=paste("worst order (max), ",round(max(He589.c.dist[[1]][,1]),2)," -> ",round(min(He589.c.dist[[1]][,1]),2),sep=""), line=3,side=1,srt=0) #dev.off() color.matrix.perm.denovo <- function(x, refset, testset, filename="", method="pearson", ssqflag=1){ data.color <- enumeration.search.dep.boots.f90.base.dist(x=x, refset=refset, testset=testset, method=method, zz=NULL, prox.only=F, output="boot.raw.col", ssqflag=ssqflag) min.pos <- which.min(data.color[[1]]) max.pos <- which.max(data.color[[1]]) cat("\n min pos ",min.pos,", max pos ",max.pos,"\n") pdf(file=paste(getwd(),"/",filename,".",format(Sys.time(), "%Y%m%d%H%M"),".pdf", sep=""), width=11, height=7, onefile=T, title="color.matrix.perm denovo", pointsize=12) color.matrix.perm(x=as.data.frame(data.color[[3]]), col.range="cgh", mincolval=NULL, maxcolval=NULL, reset.col=T, text="start order", cex=0.7) color.matrix.perm(x=as.data.frame(data.color[[3]][data.color[[2]][min.pos,],]), col.range="cgh", mincolval=NULL, maxcolval=NULL, reset.col=F, text="min ssqg", cex=0.7) color.matrix.perm(x=as.data.frame(data.color[[3]][data.color[[2]][max.pos,],]), col.range="cgh", mincolval=NULL, maxcolval=NULL, reset.col=T, text="max ssqg", cex=0.7) dev.off() return() } #color.matrix.perm.denovo(x=He589.c, refset=c(1,2,3,5,12,13), testset=c(4,6:11,14:16), filename="test1", method="pearson", ssqflag=1) ### under development r.score <- function(num, start, end){ } v.values <- function(ne){ # calculate rank weight values len.ne <- length(ne) if(len.ne<3){ cat("\n we need at least 3 test factors "); stop() } if(len.ne %% 2 == 0){ len.ne2 <- len.ne/2 # is even , do not use first in seq seq(0.1,1,) }else{ len.ne2 <- len.ne/2 # is odd , } len.sp <- 1/(len.ne - 1) # n-1 spacer, n positions len.seq <- seq(0,1,len.sp) # seq(0,1,1/2) tmp <- ne for(i in 1:len.ne){ } return() } rank.score <- function(z,o){ # calculate rank score for all test factors # rank gets a v function weigth from 0..1 (first and last percentil: 1, at the 50th percentil: 0) # slope [0..+/-inf) will be transformed by logistic function to [0..+/-1) # rank value * logistic(slope) = rank score value nr <- nrow(z) nc <- ncol(z) # calculate slope for all references reg.slope <- vector("numeric",length=nc) for(i in 1:nc){ reg.slope[i] <- linfit.ab(x=o,y=z[,i])[[2]] } return(reg.slope) } #rank.score(z=aa[[3]],o=aa[[2]][which.min(aa[[1]]),]) color.matrix.rank.score.denovo <- function(x, refset, testset, filename="", method="pearson", ssqflag=1){ data.color <- enumeration.search.dep.boots.f90.base.dist(x=x, refset=refset, testset=testset, method=method, zz=NULL, prox.only=F, output="boot.raw.col", ssqflag=ssqflag) min.pos <- which.min(data.color[[1]]) min.order <- data.color[[2]][min.pos,] cat("\n min pos ",min.pos,"\n") # slope for all ref situations rankscore <- rank.score(z=data.color[[3]],o=min.order) pdf(file=paste(getwd(),"/",filename,".",format(Sys.time(), "%Y%m%d%H%M"),".pdf", sep=""), width=11, height=7, onefile=T, title="color.matrix.perm denovo", pointsize=12) color.matrix.perm(x=as.data.frame(data.color[[3]]), col.range="cgh", mincolval=NULL, maxcolval=NULL, reset.col=T, text="start order", cex=0.7) color.matrix.perm(x=as.data.frame(data.color[[3]][data.color[[2]][min.pos,],]), col.range="cgh", mincolval=NULL, maxcolval=NULL, reset.col=F, text="min ssqg", cex=0.7) color.matrix.perm(x=as.data.frame(data.color[[3]][data.color[[2]][max.pos,],]), col.range="cgh", mincolval=NULL, maxcolval=NULL, reset.col=T, text="max ssqg", cex=0.7) dev.off() return() } #color.matrix.rank.score.denovo(x=He589.c, refset=c(1,2,3,5,12,13), testset=c(4,6:11,14:16), filename="test1", method="pearson", ssqflag=1)