R/plot-methods.R
a9f5d029
 ## Define methods for plot generic function
 ##
 ## Gustavo H. Esteves
 ## 27/05/07
 ##
 ##
 
 
 ## For maigesRaw class
 plot.maigesRaw <- function(x, bkgSub="subtract", z=NULL, legend.func=NULL,
 ylab="W", ...) {
 
     ## Correcting background
     tmp <- backgroundCorrect(as(x, "RGList"), bkgSub)
     tmp <- as(tmp, "marrayRaw")
     tmp <- as(tmp, "marrayNorm")
 
     ## indexing ref labelled with green
     idx <- tolower(getLabels(x, "Ref")) == "red"
     if(sum(idx) > 0)
         maM(tmp)[, idx] <- -maM(tmp)[, idx]
 
     maLabels(maTargets(tmp)) <- as.character(maInfo(maTargets(tmp))[[1]])
     maPlot(tmp, z=z, legend.func=legend.func, ylab=ylab, ...)
 }
 
 
 ## For maiges class
 plot.maiges <- function(x, z=NULL, legend.func=NULL, ylab="W", ...) {
 
     ## Converting to marrayNorm class (from marray package)
     tmp <- as(x, "marrayNorm")
 
     ## indexing ref labelled with green
     idx <- tolower(getLabels(x, "Ref")) == "red"
     if(sum(idx) > 0)
         maM(tmp)[, idx] <- -maM(tmp)[, idx]
 
     maPlot(tmp, z=z, legend.func=legend.func, ylab=ylab, ...)
 
 }
 
 
 ## For maigesANOVA class
 plot.maigesANOVA <- plot.maiges
 
 
 ## For maigesDE class (shows volcano plot)
 plot.maigesDE <- function(x, adjP="none", idx=1, ...) {
 
     ## Adjusting p-values if specified by the user.
     if(adjP != "none") {
         tmp1 <- multtest::mt.rawp2adjp(x@p.value[, idx], proc=adjP)
         x@p.value[, idx] <- tmp1$adjp[order(tmp1$index), 2]
     }
 
     if(sum(dim(x@fold)) == 0)
         stop("I can't plot volcano with fold slot empty.")
     else
         tmp1 <- x@fold[, idx]
 
     tmp2 <- -log10(x@p.value[, idx])
     if(!is.null(colnames(x@stat)[idx]))
         plotName <- colnames(x@stat)[idx]
     else
         plotName <- x@test
 
     plot(tmp1, tmp2, main=paste("Volcano plot -", plotName), xlab="log2(fold)",
     ylab=paste("-log10(P.value)"), ...)
 
 }
 
 
 ## For maigesDEcluster class
 plot.maigesDEcluster <- function(x, adjP="none", idx=1, ...) {
 
     ## Adjusting p-values if specified by the user.
     if(adjP != "none") {
         tmp1 <- multtest::mt.rawp2adjp(x@p.value[, idx], proc=adjP)
         x@p.value[, idx] <- tmp1$adjp[order(tmp1$index), 2]
     }
 
     if(sum(dim(x@fold)) == 0)
         tmp1 <- apply(x@W, 1, mean, na.rm=TRUE)
     else
         tmp1 <- x@fold[, idx]
 
     tmp2 <- -log10(x@p.value[, idx])
     if(!is.null(colnames(x@stat)[idx]))
         plotName <- colnames(x@stat)[idx]
     else
         plotName <- x@test
 
     plot(tmp1, tmp2, main=paste("Volcano plot -", plotName), xlab="log2(fold)",
     ylab=paste("-log10(P.value)"), ...)
 
 }
 
 
 ## For maigesClass class (bi or tri-dimensional graphs of classifiers)
 plot.maigesClass <- function(x, idx=1, ...) {
 
     ## Getting sample types
     types <- colnames(x@W)
     uTypes <- unique(types)
 
     if(dim(x@cliques)[2] == 2) {
         tmp1 <- x@W[x@cliques.idx[idx, 1], ]
         tmp2 <- x@W[x@cliques.idx[idx, 2], ]
         xlimite <- c(2*min(tmp1)-quantile(tmp1, 0.35), max(tmp1))
         ylimite <- c(min(tmp2), 2*max(tmp2)-quantile(tmp2, 0.65))
 
         toLegend <- c(2*min(tmp1)-quantile(tmp1, 0.3),
         2*max(tmp2)-quantile(tmp2, 0.7))
 
         plot(tmp1[types == uTypes[1]], tmp2[types == uTypes[1]], ylim=ylimite,
         xlim=xlimite, main="Classification graphic", xlab=x@cliques[idx,1],
         ylab=x@cliques[idx,2], pch=22, bg="red", col="red", ...)
 
         points(tmp1[types == uTypes[2]], tmp2[types == uTypes[2]], pch=19,
         col="green")
 
         legend(toLegend[1], toLegend[2], uTypes, pch=c(22,19),
         pt.bg=c("red","green"), col=c("red", "green"))
 
     }
     else if(dim(x@cliques)[2] == 3) {
 
         ## Loading required library
         require("rgl")
 
         tmp1 <- x@W[x@cliques.idx[idx, 1], ]
         tmp2 <- x@W[x@cliques.idx[idx, 2], ]
         tmp3 <- x@W[x@cliques.idx[idx, 3], ]
 
         labels <- c(x@cliques[idx, 1], x@cliques[idx, 2], x@cliques[idx, 3])
 
         rgl::open3d()
 
         rgl::text3d(tmp1[types == uTypes[1]], tmp2[types == uTypes[1]],
         tmp3[types == uTypes[1]], text=types[types == uTypes[1]], col="red")
 
         rgl::text3d(tmp1[types != uTypes[1]], tmp2[types != uTypes[1]],
         tmp3[types != uTypes[1]], text=types[types != uTypes[1]], col="green")
 
         rgl::decorate3d(xlab=labels[1], ylab=labels[2], zlab=labels[3],
         box=FALSE)
 
         rgl::bbox3d(color=c("#767676","black"), emission="#767676",
         specular="#767676", shininess=10, alpha=0.9, marklen=50)
     }
     else
         stop("I can't plot graphics with more than 3 genes in the classifiers!")
 
 }
 
 
 ## For maigesRelNetM class (circular graph with significative iterations)
 plot.maigesRelNetM <- function(x=NULL, cutPval=0.05, names=NULL, ...) {
 
     ## Giving default names if it is NULL
     if(is.null(names))
         names <- c(x@types, "Significance of differences")
 
 
     ## Defining additional functions
     graphPath <- function(data=NULL, cuttoffPvalue) {
         N <- length(rownames(data@Corr1))
         corObj1 <- data@Corr1
         corObj2 <- data@Corr2
         Diff <- data@DifP
         ## Construct graphs centered on the 1st table
         vertices <- rownames(corObj1)
         arestas1 <- vector("list", length=length(vertices))
         names(arestas1) <- vertices
         arestas3 <- arestas2 <- arestas1
         for (i in 1:length(vertices)) {
             idx <- Diff[i, ] <= cuttoffPvalue
             arestas1[[i]] <- list(edges=vertices[idx],
             weights=unname(corObj1[i, idx]))
 
             arestas2[[i]] <- list(edges=vertices[idx],
             weights=unname(corObj2[i, idx]))
 
             arestas3[[i]] <- list(edges=vertices[idx],
             weights=unname(Diff[i, idx]))
         }
 
         ## Defining the object with the graphs
         Path <- list(Type1=new("graphNEL", vertices, edgeL=arestas1),
         Type2=new("graphNEL", vertices, edgeL=arestas2),
         Dif=new("graphNEL", vertices, edgeL=arestas3))
 
         return(Path)
     }
 
     plot.dots <- function(xy, v, n) {
         text(xy[, 1], xy[, 2], v, cex=1.2, col="blue")
     }
 
     draw.edges <- function(coor, vertices, edges, alpha, sorting) {
 
         main <- edges[[1]]
         a <- coor[which(vertices == main), ]
         if(sorting == "A")
             strength <- order(abs(edges[[3]]))
         else
             strength <- order(abs(edges[[3]]), decreasing=TRUE)
 
         for (k in 1:length(edges[[2]])) {
             b <- coor[edges[[2]][k], ]
             ba <- b-a
             ba <- ba/sqrt(sum(ba*ba))
             x <- a+ba*alpha
             y <- b-ba*alpha
             if (edges[[3]][k] > 0 )
                 color <- "red"
             else
                 color <- "green"
             a1 <- c(x[1], y[1])
             a2 <- c(x[2], y[2])
 
             lines(a1, a2, lwd=strength[k], lty=1, col=color)
         }
     }
 
     def.coor <- function(ce, k, h, w) {
         if (k == 1)
             return(ce)
         else if (k == 2) {
             r1 <- c(ce[1], ce[1])
             r2 <- c(ce[2]+h*0.3, ce[2]-h*0.3)
         }
         else if (k == 3) {
             r1 <- c(ce[1], ce[1], ce[1])
             r2 <- c(ce[2]+h*0.25, ce[2], ce[2]-h*0.25)
         }
         else if (k == 4) {
             r1 <- c(ce[1]-w*0.3, ce[1]+w*0.3, ce[1]+w*0.3, ce[1]-w*0.3)
             r2 <- c(ce[2]-h*0.3, ce[2]-h*0.3, ce[2]+h*0.3, ce[2]+h*0.3)
         }
         else {
             a <- 1
             z <- seq(a, a+2*pi, len=k+1)
             z <- z[-1]
             r1 <- ce[1]+w/2.5*cos(z)
             r2 <- ce[2]+h/2.5*sin(z)
         }
         cbind(r1, r2)
     }
 
     plotGraph <- function (graph, coor=NULL, alpha=2.5, main="Some Graph",
     sorting) {
 
         ## Define the nodes and the length of the graph (number of nodes)
         v <- nodes(graph)
         n <- length(v)
 
         ## Create an empty draw device
         plot(c(0, 100), c(0, 100), type="n", axes=FALSE, xlab="", ylab="",
         main=main)
 
         ## Define an initial center to the graph
         center <- matrix(c(50, 50), ncol=2)
 
         ## Create an object of the locations for each node
         if (is.null(coor))
             coor <- def.coor(center, n, 100, 100)
 
         ## Plot each node on the device
         plot.dots(coor, v, n)
 
         ## Locate the nodes to plot on the figure
         for (i in 1:n) {
             if(length(edgeL(graph)[[i]]$edges) > 0) {
                 elo <- list(v[i], edgeL(graph)[[i]]$edges,
                 as.numeric(edgeWeights(graph, i)[[1]]))
                 draw.edges(coor, v, elo, alpha, sorting)
             }
         }
         colnames(coor) <- c("x", "y")
         return(invisible(coor))
     }
 
 
     ## Ploting the graphs
     graph <- graphPath(x, cutPval)
 
     par(mfrow=c(1,3))
     tmp <- plotGraph(graph[[1]], main=names[1], sorting="A")
     plotGraph(graph[[2]], coor=tmp, main=names[2], sorting="A")
     plotGraph(graph[[3]], coor=tmp, main=names[3], sorting="D")
 
 }
 
 
 ## For maigesRelNetB class (circular graph with significative iterations)
 plot.maigesRelNetB <- function(x=NULL, cutPval=0.05, cutCor=NULL, name=NULL,
 ...) {
 
     ## Some tests
     if(!is.null(cutPval) & !is.null(cutCor))
         stop("You must specify only, cutPval or cutCor.")
 
     if(is.null(name))
         name <- x@type
 
     ## Defining additional functions
     graphPath <- function(data=NULL, cuttoffCor=NULL, cuttoffP=NULL) {
 
         N <- length(rownames(data@Corr))
         corObj <- data@Corr
         ## Construct graphs centered on the 1st table
         vertices <- rownames(corObj)
         arestas <- vector("list", length=length(vertices))
         names(arestas) <- vertices
         for (i in 1:length(vertices)) {
             if(!is.null(cuttoffCor))
                 idx <- abs(corObj[i, ]) >= cuttoffCor
             if(!is.null(cuttoffP))
                 idx <- abs(data@Pval[i, ]) <= cuttoffP
             arestas[[i]] <- list(edges=vertices[idx], weights=unname(corObj[i, idx]))
         }
 
         ## Defining the object with the graphs
         Path <- new("graphNEL", vertices, edgeL=arestas)
         return(Path)
     }
 
     plot.dots <- function(xy, v, n) {
         text(xy[, 1], xy[, 2], v, cex=1.2, col="blue")
     }
 
     draw.edges <- function(coor, vertices, edges, alpha, sorting) {
 
         main <- edges[[1]]
         a <- coor[which(vertices == main), ]
         if(sorting == "A")
             strength <- order(abs(edges[[3]]))
         else
             strength <- order(abs(edges[[3]]), decreasing=TRUE)
 
         for (k in 1:length(edges[[2]])) {
             b <- coor[edges[[2]][k], ]
             ba <- b-a
             ba <- ba/sqrt(sum(ba*ba))
             x <- a+ba*alpha
             y <- b-ba*alpha
             if (edges[[3]][k] > 0 )
                 color <- "red"
             else
                 color <- "green"
             a1 <- c(x[1], y[1])
             a2 <- c(x[2], y[2])
             lines(a1, a2, lwd=strength[k], lty=1, col=color)
         }
     }
 
     def.coor <- function(ce, k, h, w) {
         if (k == 1)
             return(ce)
         else if (k == 2) {
             r1 <- c(ce[1], ce[1])
             r2 <- c(ce[2]+h*0.3, ce[2]-h*0.3)
         }
         else if (k == 3) {
             r1 <- c(ce[1], ce[1], ce[1])
             r2 <- c(ce[2]+h*0.25, ce[2], ce[2]-h*0.25)
         }
         else if (k == 4) {
             r1 <- c(ce[1]-w*0.3, ce[1]+w*0.3, ce[1]+w*0.3, ce[1]-w*0.3)
             r2 <- c(ce[2]-h*0.3, ce[2]-h*0.3, ce[2]+h*0.3, ce[2]+h*0.3)
         }
         else {
             a <- 1
             z <- seq(a, a+2*pi, len=k+1)
             z <- z[-1]
             r1 <- ce[1]+w/2.5*cos(z)
             r2 <- ce[2]+h/2.5*sin(z)
         }
         cbind(r1, r2)
     }
 
     plotGraph <- function (graph, coor=NULL, alpha=2.5, main="Some Graph",
     sorting) {
 
         ## Define the nodes and the length of the graph (number of nodes)
         v <- nodes(graph)
         n <- length(v)
 
         ## Create an empty draw device
         plot(c(0, 100), c(0, 100), type="n", axes=FALSE, xlab="", ylab="",
         main=main)
 
         ## Define an initial center to the graph
         center <- matrix(c(50, 50), ncol=2)
 
         ## Create an object of the locations for each node
         if (is.null(coor)) {
             coor <- def.coor(center, n, 100, 100)
         }
         ## Plot each node on the device
         plot.dots(coor, v, n)
         ## Locate the nodes to plot on the figure
         for (i in 1:n) {
             if(length(edgeL(graph)[[i]]$edges) > 0) {
                 elo <- list(v[i], edgeL(graph)[[i]]$edges,
                 as.numeric(edgeWeights(graph, i)[[1]]))
                 ##if(length(elo[[2]]) > 0)
                 draw.edges(coor, v, elo, alpha, sorting)
             }
         }
         colnames(coor) <- c("x", "y")
         return(invisible(coor))
     }
 
 
     if(!is.null(cutCor)) {
         ## geting maximum bootstrap value to use in cutCor
         if((is.character(cutCor)) & (cutCor == "max"))
             cutCor <- max(x@maxB[upper.tri(x@maxB)])
         else if((cutCor < 0) | (cutCor >= 1))
             stop("cutCor must a number in [0,1) or 'max'.")
 
         ## Ploting the graphs
         graph <- graphPath(x, cutCor, NULL)
         plotGraph(graph, main=name, sorting="A")
     }
     else {
         ## Ploting the graphs
         graph <- graphPath(x, NULL, cutPval)
         plotGraph(graph, main=name, sorting="A")
     }
 }
 
 
 ## For maigesActMod class (heatmap of the significative results)
 plot.maigesActMod <- function(x, type=c("S", "C")[2], keepEmpty=FALSE, ...) {
 
     ## Making some basic initial tests...
     if(is.null(x))
         stop("You MUST specify an object generated by activeMod function.")
     if(!is.element(type, c("S", "C")))
         stop("You must be 'C' or 'S'.")
 
     if(type == "S") {
         if(keepEmpty)
             table <- x@modBySamp
         else {
             idx <- apply(x@modBySamp != 0, 2, sum, na.rm=TRUE) != 0
             if(sum(idx) < 2)
                 stop("Less than 2 elements present significant results!")
             table <- x@modBySamp[, idx]
         }
         limite <- max(abs(range(table, na.rm=TRUE)))
         limite <- c(-limite, limite)
         idx1 <- order(rownames(table))
         idx2 <- order.dendrogram(as.dendrogram(hclust(dist(t(table)))))
 
caf9db56
         heatmap(table[idx1, idx2], scale="none", col=greenRed(),
a9f5d029
         zlim=limite, Rowv=NA, Colv=NA, ...)
 
     }
     else if(type == "C") {
         if(keepEmpty)
             table <- x@modByCond
         else {
             idx <- apply(x@modByCond != 0, 2, sum, na.rm=TRUE) != 0
             if(sum(idx) < 2)
                 stop("Less than 2 elements present significant results!")
             table <- x@modByCond[, idx]
         }
         limite <- max(abs(range(table, na.rm=TRUE)))
         limite <- c(-limite, limite)
         idx1 <- order(rownames(table))
         idx2 <- order.dendrogram(as.dendrogram(hclust(dist(t(table)))))
 
caf9db56
         heatmap(table[idx1, idx2], scale="none", col=greenRed(),
a9f5d029
         zlim=limite, Rowv=NA, Colv=NA, ...)
 
     }
 }
 
 
 ## For maigesActNet class (heatmap of the significative results)
 plot.maigesActNet <- function(x, type=c("score","p-value")[1], ...) {
 
     ## Making some basic initial tests...
     if(is.null(x))
         stop("You MUST specify an object generated by activeNet function.")
     if(!is.element(type, c("score", "p-value")))
         stop("You must be 'score' or 'p-value'.")
 
     if(type == "score") {
         limite <- max(x@scores, na.rm=TRUE)
         limite <- c(0, limite)
         idx <- order.dendrogram(as.dendrogram(hclust(dist(t(x@scores)))))
 
caf9db56
         heatmap(x@scores[, idx], scale="none", col=blackBlue(),
a9f5d029
         zlim=limite, Rowv=NA, Colv=NA, ...)
 
     }
     else {
 
         limite = max(-log10(x@Pvalues), na.rm=TRUE)
         limite = c(0, limite)
         
         idx <- order.dendrogram(as.dendrogram(hclust(dist(t(x@Pvalues)))))
         
         heatmap(-log10(x@Pvalues)[, idx], scale="none",
caf9db56
         col=blackBlue(), zlim=limite, Rowv=NA, Colv=NA, ...)
a9f5d029
 
     }
 }