R/image.lewy.iq.R

In vladpetyuk/LewyBodies.SN.TopDown: What the package does (short line)

#' plots Top-Down IQ data
#' 
#' A variation of \code{\link[LewyBodies.CSF.SRM]{image.lewy}}
#' 
#' @param m MSnSet object
#' @param valueName name of the value to be displayed
#' 
#' @importFrom reshape2 melt
#' @importFrom ggplot2 ggplot geom_raster scale_fill_gradientn aes facet_grid
#' @importFrom ggplot2 theme element_blank element_rect xlab ylab labs
#' @importFrom scales rescale
#' @importFrom gplots bluered
#' @importFrom grid unit
#' @export image.lewy.iq
#' 
image.lewy.iq <- function(m, valueName="value"){
    
    # convertion to long format
    mlong <- melt(exprs(m), varnames=c("Feature", "Sample.ID"), 
                  value.name='value')
    mlong$Feature <- as.character(mlong$Feature)
    mlong$Sample.ID <- as.character(mlong$Sample.ID)
    mlong <- merge(mlong, fData(m), by.x="Feature", by.y="row.names")
    mlong <- merge(mlong, pData(m), by.x="Sample.ID", by.y="row.names")
    x <- mlong    
    x$Peptide.ID <- ordered(x$Feature, levels=rev(sort(unique(x$Feature))))
    qn <- mean(abs(quantile(x$value, c(0.025, 0.975), na.rm = TRUE)))
    qn <- c(-qn, +qn)
    qn01 <- rescale (c (qn, range (x$value, na.rm=TRUE))) 
    
    gLabeller <- function(var, value){
        value <- as.character(value)
        if (var=="subject.type") { 
            value[value=="case"] <- "Cases with Lewy Bodies"
            value[value=="control.1"]   <- "Controls, Matched by Neuronal Loss"
            value[value=="control.2"]   <- "Controls, Not Matched by Neuronal Loss"
        }
        return(value)
    }
    
    p <- ggplot(x, aes(x=match.group, y=Feature, fill=value)) + 
        geom_raster() +
        scale_fill_gradientn(
            colours=bluered(100),
            values = c(0, seq(qn01[1], qn01[2], length.out = 98), 1)) +
        facet_grid( ~ subject.type, labeller=gLabeller) +
        theme(
            panel.grid.major = element_blank(),
            panel.grid.minor = element_blank(),
            panel.margin = unit(1.5, "lines"),
            panel.border = element_rect(linetype = "dashed", 
                                        size=1, colour = "black", fill=NA),
            legend.key.height = unit(2, "lines")
        ) +
        xlab("matching group #") +
        ylab("feature") +
        labs(fill=valueName)
    return(p)
}