Nothing
#' 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)
}
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.