R/VolcanoPlot.R

In iSEEu: iSEE Universe

#' The VolcanoPlot class
#'
#' The VolcanoPlot is a \linkS4class{RowDataPlot} subclass that is dedicated to creating a volcano plot.
#' It retrieves the log-fold change and p-value from and creates a row-based plot where each point represents a feature.
#' Users are expected to load relevant statistics into the \code{\link{rowData}} of a \linkS4class{SummarizedExperiment}.
#'
#' @section Slot overview:
#' The following slots control the thresholds used in the visualization:
#' \itemize{
#' \item \code{PValueThreshold}, a numeric scalar in (0, 1] specifying the threshold to use on the (adjusted) p-value.
#' Defaults to 0.05.
#' \item \code{LogFCThreshold}, a non-negative numeric scalar specifying the threshold to use on the log-fold change.
#' Defaults to 0.
#' \item \code{PValueCorrection}, a string specifying the multiple testing correction to apply.
#' Defaults to \code{"BH"}, but can take any value from \code{\link{p.adjust.methods}}.
#' }
#'
#' The following slots control the choice of columns in the user interface:
#' \itemize{
#' \item \code{PValuePattern}, a character vector specifying the patterns of all potential columns containing p-values, see \code{\link{getPValuePattern}}.
#' \item \code{LogFCPattern}, a character vector specifying the patterns of all potential columns containing log-fold changes, see \code{\link{getLogFCPattern}}.
#' }
#'
#' In addition, this class inherits all slots from its parent \linkS4class{RowDataPlot},
#' \linkS4class{RowDotPlot}, \linkS4class{DotPlot} and \linkS4class{Panel} classes.
#'
#' @section Constructor:
#' \code{VolcanoPlot(...)} creates an instance of a VolcanoPlot class,
#' where any slot and its value can be passed to \code{...} as a named argument.
#'
#' Initial values for \code{PValuePattern} and \code{LogFCPattern} are set to the outputs of \code{\link{getPValuePattern}} and \code{\link{getLogFCPattern}}, respectively.
#' These parameters are considered to be global constants and cannot be changed inside the running \code{iSEE} application.
#' Similarly, it is not possible for multiple VolcanoPlots in the same application to have different values for these slots;
#' within the app, all values are set to those of the first encountered VolcanoPlot to ensure consistency.
#'
#' @section Supported methods:
#' In the following code snippets, \code{x} is an instance of a \linkS4class{RowDataPlot} class.
#' Refer to the documentation for each method for more details on the remaining arguments.
#'
#' For setting up data values:
#' \itemize{
#' \item \code{\link{.cacheCommonInfo}(x, se)} returns \code{se} after being loaded with class-specific constants.
#' This includes \code{"valid.p.fields"} and \code{"valid.lfc.fields"}, character vectors containing the names of valid \code{\link{rowData}} columns for the p-values and log-fold changes, respectively.
#' \item \code{\link{.refineParameters}(x, se)} returns \code{x} after setting \code{XAxis="Row data"} and the various \code{*Pattern} fields to their cached values.
#' This will also call the equivalent \linkS4class{RowDataPlot} method for further refinements to \code{x}.
#' If valid p-value and log-fold change fields are not available, \code{NULL} is returned instead.
#' }
#'
#' For defining the interface:
#' \itemize{
#' \item \code{\link{.defineDataInterface}(x, se, select_info)} returns a list of interface elements for manipulating all slots described above.
#' \item \code{\link{.panelColor}(x)} will return the specified default color for this panel class.
#' \item \code{\link{.allowableXAxisChoices}(x, se)} returns a character vector specifying the acceptable log-fold change-related variables in \code{\link{rowData}(se)} that can be used as choices for the x-axis.
#' \item \code{\link{.allowableYAxisChoices}(x, se)} returns a character vector specifying the acceptable p-value-related variables in \code{\link{rowData}(se)} that can be used as choices for the y-axis.
#' \item \code{\link{.hideInterface}(x, field)} will return \code{TRUE} for \code{field="XAxis"},
#' otherwise it will call the \linkS4class{RowDataPlot} method.
#' \item \code{\link{.fullName}(x)} will return \code{"Volcano plot"}.
#' }
#'
#' For monitoring reactive expressions:
#' \itemize{
#' \item \code{\link{.createObservers}(x, se, input, session, pObjects, rObjects)} sets up observers for all new slots described above, as well as in the parent classes via the \linkS4class{RowDataPlot} method.
#' }
#'
#' For creating the plot:
#' \itemize{
#' \item \code{\link{.generateDotPlotData}(x, envir)} will create a data.frame of row metadata variables in \code{envir}.
#' This should contain negative log-transformed p-values on the y-axis and log-fold changes on the x-axis,
#' in addition to an extra field specifying whether or not the feature was considered to be significantly up or down.
#' The method will return the commands required to do so as well as a list of labels.
#' \item \code{\link{.prioritizeDotPlotData}(x, envir)} will create variables in \code{envir} marking the priority of points.
#' Significant features receive higher priority (i.e., are plotted over their non-significant counterparts) and are less aggressively downsampled when \code{Downsample=TRUE}.
#' The method will return the commands required to do this as well as a logical scalar indicating that rescaling of downsampling resolution is performed.
#' \item \code{\link{.colorByNoneDotPlotField}(x)} will return a string specifying the field of the data.frame (generated by \code{\link{.generateDotPlotData}}) containing the significance information.
#' This is to be used for coloring when \code{ColorBy="None"}.
#' \item \code{\link{.colorByNoneDotPlotScale}(x)} will return a string containing a \pkg{ggplot2} command to add a default color scale when \code{ColorBy="None"}.
#' \item \code{\link{.generateDotPlot}(x, labels, envir)} returns a list containing \code{plot} and \code{commands}, using the inital \linkS4class{ColumnDataPlot} \link{ggplot} and adding vertical lines demarcating the log-fold change threshold.
#' }
#'
#' For documentation:
#' \itemize{
#' \item \code{\link{.definePanelTour}(x)} returns an data.frame containing the steps of a panel-specific tour.
#' }
#'
#' @docType methods
#' @aliases VolcanoPlot VolcanoPlot-class
#' initialize,VolcanoPlot-method
#' .cacheCommonInfo,VolcanoPlot-method
#' .refineParameters,VolcanoPlot-method
#' .defineDataInterface,VolcanoPlot-method
#' .createObservers,VolcanoPlot-method
#' .hideInterface,VolcanoPlot-method
#' .fullName,VolcanoPlot-method
#' .panelColor,VolcanoPlot-method
#' .generateDotPlotData,VolcanoPlot-method
#' .allowableXAxisChoices,VolcanoPlot-method
#' .allowableYAxisChoices,VolcanoPlot-method
#' .prioritizeDotPlotData,VolcanoPlot-method
#' .colorByNoneDotPlotField,VolcanoPlot-method
#' .colorByNoneDotPlotScale,VolcanoPlot-method
#' .generateDotPlot,VolcanoPlot-method
#' .definePanelTour,VolcanoPlot-method
#'
#' @examples
#' # Making up some results:
#' se <- SummarizedExperiment(matrix(rnorm(10000), 1000, 10))
#' rownames(se) <- paste0("GENE_", seq_len(nrow(se)))
#' rowData(se)$PValue <- runif(nrow(se))
#' rowData(se)$LogFC <- rnorm(nrow(se))
#' rowData(se)$AveExpr <- rnorm(nrow(se))
#'
#' if (interactive()) {
#'     iSEE(se, initial=list(VolcanoPlot()))
#' }
#'
#' @author Aaron Lun
#'
#' @importFrom SummarizedExperiment rowData
#'
#' @seealso
#' \link{RowDataPlot}, for the base class.
#' @name VolcanoPlot-class
NULL

#' @export
setClass("VolcanoPlot", contains="RowDataPlot",
    slots=c(PValueThreshold="numeric", LogFCThreshold="numeric", PValueCorrection="character",
        PValuePattern="character", LogFCPattern="character"))

#' @export
setMethod(".fullName", "VolcanoPlot", function(x) "Volcano plot")

#' @export
setMethod(".panelColor", "VolcanoPlot", function(x) "#DEAE10")

#' @export
setMethod("initialize", "VolcanoPlot", function(.Object, PValueThreshold=0.05,
    LogFCThreshold=0, PValueCorrection="BH", ...)
{
    args <- list(PValueThreshold=PValueThreshold,
        LogFCThreshold=LogFCThreshold, PValueCorrection=PValueCorrection, ...)

    args$PValuePattern <- getPValuePattern()
    args$LogFCPattern <- getLogFCPattern()

    do.call(callNextMethod, c(list(.Object), args))
})

#' @export
#' @importFrom methods new
VolcanoPlot <- function(...) {
    new("VolcanoPlot", ...)
}

#' @importFrom stats p.adjust.methods
setValidity2("VolcanoPlot", function(object) {
    msg <- .define_de_validity(object, patterns=c("PValuePattern", "LogFCPattern"))
    if (length(msg)) msg else TRUE
})

#' @export
setMethod(".cacheCommonInfo", "VolcanoPlot", function(x, se) {
    if (!is.null(.getCachedCommonInfo(se, "VolcanoPlot"))) {
        return(se)
    }

    se <- callNextMethod()
    all.cont <- .getCachedCommonInfo(se, "RowDotPlot")$continuous.rowData.names

    # NOTE: these fields are assumed to be globals, so it's okay to use their
    # values when caching the common values.  The plan is to use
    # .refineParameters to force all VolcanoPlots to use the fields defined by
    # the patterns of the first encountered VolcanoPlot.
    p.okay <- .match_acceptable_fields(x[["PValuePattern"]], all.cont)
    lfc.okay <- .match_acceptable_fields(x[["LogFCPattern"]], all.cont)

    .setCachedCommonInfo(se, "VolcanoPlot", valid.lfc.fields=lfc.okay, valid.p.fields=p.okay)
})

#' @export
#' @importFrom methods callNextMethod
setMethod(".refineParameters", "VolcanoPlot", function(x, se) {
    x <- callNextMethod() # Trigger warnings from base classes.
    if (is.null(x)) {
        return(NULL)
    }

    x[["XAxis"]] <- "Row data"
    x
})

#' @export
setMethod(".allowableXAxisChoices", "VolcanoPlot", function(x, se) .getCachedCommonInfo(se, "VolcanoPlot")$valid.lfc.fields)

#' @export
setMethod(".allowableYAxisChoices", "VolcanoPlot", function(x, se) .getCachedCommonInfo(se, "VolcanoPlot")$valid.p.fields)

#' @export
#' @importFrom shiny numericInput selectInput hr
#' @importFrom stats p.adjust.methods
setMethod(".defineDataInterface", "VolcanoPlot", function(x, se, select_info) {
    plot_name <- .getEncodedName(x)
    input_FUN <- function(field) paste0(plot_name, "_", field)

    c(callNextMethod(),
        list(
            hr(),
            numericInput(input_FUN("PValueThreshold"), label="P-value threshold:",
                value=x[["PValueThreshold"]], min=0, max=1, step=0.005),
            numericInput(input_FUN("LogFCThreshold"), label="Log-FC threshold:",
                value=x[["LogFCThreshold"]], min=0, max=NA, step=0.5),
            selectInput(input_FUN("PValueCorrection"), label="Correction method:",
                selected=x[["PValueCorrection"]], choices=p.adjust.methods)
        )
    )
})

#' @export
setMethod(".hideInterface", "VolcanoPlot", function(x, field) {
    if (field == "XAxis") TRUE else callNextMethod()
})

#' @export
setMethod(".createObservers", "VolcanoPlot", function(x, se, input, session, pObjects, rObjects) {
    callNextMethod()

    plot_name <- .getEncodedName(x)

    .createUnprotectedParameterObservers(plot_name,
        fields=c("PValueThreshold", "LogFCThreshold", "PValueCorrection"),
        input=input, pObjects=pObjects, rObjects=rObjects)
})

#' @export
setMethod(".generateDotPlotData", "VolcanoPlot", function(x, envir) {
    output <- callNextMethod()

    extra_cmds <- c(
        .define_de_status(x, lfc="plot.data$X", pval="plot.data$Y"),
        "plot.data$IsSig <- c('down', 'none', 'up')[.de_status];",
        "plot.data$Y <- -log10(plot.data$Y)"
    )
    eval(parse(text=extra_cmds), envir)

    output$commands <- c(output$commands, extra_cmds)
    output$labels$Y <- sprintf("-Log10[%s]", output$labels$Y)
    output
})

#' @export
setMethod(".prioritizeDotPlotData", "VolcanoPlot", function(x, envir) .define_de_priority(envir))

#' @export
setMethod(".colorByNoneDotPlotField", "VolcanoPlot", function(x) "IsSig")

#' @export
setMethod(".colorByNoneDotPlotScale", "VolcanoPlot", function(x) .de_color_scale)

#' @export
#' @importFrom ggplot2 geom_vline
setMethod(".generateDotPlot", "VolcanoPlot", function(x, labels, envir) {
    output <- callNextMethod()

    # Adding the horizontal lines.
    extras <- "dot.plot <- dot.plot +"
    lfc <- x[["LogFCThreshold"]]
    if (lfc > 0) {
        # No idea why I need ggplot2:: here, but it just can't find it otherwise.
        extras <- c(extras, sprintf("ggplot2::geom_vline(xintercept=c(-1, 1)*%s, color=\"darkgreen\", linetype=\"dashed\")", lfc))
    }

    if (length(extras) > 1) {
        extras <- paste(extras, collapse="\n    ")
        output$commands <- c(output$commands, list(volcano=extras))
        output$plot <- eval(parse(text=extras), envir=envir)
    }

    output
})

#' @export
setMethod(".definePanelTour", "VolcanoPlot", function(x) {
    prev <- callNextMethod()
    skip <- grep("VisualBoxOpen$", prev$element)
    prev <- prev[-seq_len(skip-1),]

    rbind(
        c(paste0("#", .getEncodedName(x)), sprintf("The <font color=\"%s\">Volcano plot</font> panel shows the (log-transformed) p-value from a differential comparison against the log-fold change. Each point here corresponds to a feature in our <code>SummarizedExperiment</code>, and the number of significantly different features in the comparisons is shown in the legend.", .getPanelColor(x))),
        c(paste0("#", .getEncodedName(x), "_DataBoxOpen"), "The <i>Data parameters</i> box shows the available parameters that can be tweaked in this plot.<br/><br/><strong>Action:</strong> click on this box to open up available options."),
        c(paste0("#", .getEncodedName(x), "_YAxis + .selectize-control"), "We can control the columns containing the p-values for all features, based on the available fields in the <code>rowData</code> of the <code>SummarizedExperiment</code>. Note that these values should not be log-transformed, as the panel will take care of that itself."),
        c(paste0("#", .getEncodedName(x), "_XAxisRowData + .selectize-control"), "Similarly, we can control the columns containing the log-fold change of each feature, again based on the <code>rowData</code> fields."),
        c(paste0("#", .getEncodedName(x), "_PValueThreshold"), "A variety of thresholds can also be tuned to define significant differences; the most relevant of these is the threshold on the false discovery rate."),
        prev
    )
})