R/plot.rlrt4d.R

In vows: Voxelwise Semiparametrics

#' Display cross-sections of voxelwise RLRT results
#' 
#' Plots slices of the 3D array representing a set of voxelwise RLRT results.
#' 
#' 
#' @param x a voxelwise RLRT object as produced by \code{\link{rlrt4d}}.
#' @param array4d the 4D array on which the voxelwise RLRT was performed.
#' @param disp values from the RLRT object to be displayed: either RLRT
#' statistics, p-values, or FDR values.
#' @param titl title of the panel.
#' @param neglog10 logical; if \code{TRUE}, negative base \code{10} logarithm
#' (of the quantity specified by \code{disp}) is displayed.
#' @param threshold the upper limit of the values to be plotted. All larger
#' values will be replaced by the threshold value.
#' @param slices indices of the slice(s) to be displayed.
#' @param colbar logical: Should a color bar be included?
#' @param col.image color scheme for the color bar, as generated by
#' \code{\link{rainbow}}, \code{\link{heat.colors}}, etc.
#' @param mar A numerical vector of the form c(bottom, left, top, right)
#' specifying the number of lines of margin on the four sides of the plot.
#' @param digit number of significant digits in labels.
#' @param nrow number of rows on the plot.
#' @param \dots arguments passed to \code{\link[graphics]{plot}.}
#' @author Lei Huang \email{huangracer@@gmail.com}, Philip Reiss
#' \email{phil.reiss@@nyumc.org} and Lan Huo
#' @seealso \code{\link{rlrt4d}}
#' @examples
#' 
#' # Please see the example for rlrt4d
#' @export
plot.rlrt4d <-
function(x, array4d, disp = c("stat", "p", "fdr", "pwdf"), titl=NULL, slices = NULL, colbar = TRUE, col.image = shape::femmecol(100)[100:1], neglog10=FALSE, threshold=NULL, mar=c(2,2,2,2), digit=2, nrow=NULL, ...)  {
    disp = match.arg(disp)
    x.ind = attributes(array4d)$x.ind
    y.ind = attributes(array4d)$y.ind
    z.ind = attributes(array4d)$z.ind
    coord = attributes(array4d)$coord
    has.data = attributes(array4d)$has.data
    
    x.coord = coord[[1]]
    y.coord = coord[[2]]
    z.coord = coord[[3]]
    axis.flag = TRUE
    ttl = "z ="
    xlb="x"; ylb="y"
    
    if (!(disp %in% c("stat", "p", "fdr"))) stop("You must choose RLRT statistics, p-value or fdr to display!")
    arr = array(NA, dim=dim(has.data))
    if (disp=="stat") arr[has.data] = x$stat
    if (disp=="p") arr[has.data] = x$p
    if (disp=="fdr") arr[has.data] = x$fdr
    if (neglog10) {
    	arr[has.data] = -log10(arr[has.data])
        if (disp=="stat") warning("Do you really want to take the negative base-10 log of the RLR statistic?")
    }
    
    arr.le.th = arr.ge.th = arr
    if (!is.null(threshold)) {
        arr.le.th[!is.na(arr) & (arr>threshold)] = NA
        arr.ge.th[!is.na(arr) & (arr<=threshold)] = NA 
        arr.ge.th[!is.na(arr) & (arr>threshold)] = 1
    }
    zlim = range(c(range(arr.le.th, na.rm=TRUE), threshold), na.rm = TRUE)  
    
    if (is.null(slices)) slices = round(seq(5,dim(arr)[3]-4,,11))
    if (is.null(nrow)) nrow = ceiling(sqrt(length(slices)+colbar))
    ncol = ceiling((length(slices)+colbar)/nrow)
    par(mfrow=c(nrow, ncol), mar = mar)
    
    for (i in 1:length(slices)){
        image(x = x.coord, y=y.coord, z=arr.le.th[ , , slices[i]],
              col=col.image, main= ifelse(is.null(titl), "", paste(ttl, z.coord[slices[i]])), 
              xlab=xlb, ylab=ylb, zlim=zlim, axes=axis.flag, ...)
        if (!is.null(threshold)) {
            image(x = x.coord, y=y.coord, z=arr.ge.th[ , , slices[i]], col="grey", add=TRUE)    
        }
    }
    if (colbar) {
        shape::emptyplot(main="    ")
        shape::colorlegend(posx=c(0.6,0.7), col=col.image,
                    zlim=zlim, zval = seq(min(zlim), max(zlim), length.out=5),main="", left=FALSE, digit=digit)
    }
}