R/CRISPRball.R

In j-andrews7/CRISPRball: Shiny Application for Interactive CRISPR Screen Visualization, Exploration, Comparison, and Filtering

#' Create an interactive Shiny app for visualization & exploration of CRISPR analyses
#'
#' @details Features with no variation will be removed prior to \code{\link[PCAtools]{pca}} being run for the PCA visualization.
#' Gene labels can be added to the MAplot and volcano plot by clicking a point. The labels can also be dragged around,
#' though adding labels will reset the positions, so it's recommended to add all labels prior to re-positioning them.
#'
#' @param gene.data A named list containing \code{gene_summary.txt} tables as data.frames.
#'   Multiple data.frames may be provided, one per element of the list.
#'   Users will be able to swap between them within the app. List element names should match names of \code{sgrna.data} list elements.
#' @param sgrna.data A named list containing \code{sgrna_summary.txt} tables as data.frames.
#'   Multiple data.frames may be provided, one per element of the list.
#'   Users will be able to swap between them within the app. List element names should match names of \code{gene.data} list elements.
#' @param count.summary Matrix or dataframe containing count summary (\code{countsummary.txt}) as generated by \code{mageck count}.
#' @param norm.counts Matrix or dataframe containing normalized counts (\code{count_normalized.txt}) as generated by \code{mageck count}.
#' @param h.id String indicating unique ID for interactive plots.
#'   Required if multiple apps are run within the same Rmd file.
#' @param positive.ctrl.genes Optional character vector of gene identifiers for
#'   positive control genes from the screen so that they can be easily filtered.
#' @param essential.genes Optional character vector of gene identifiers of common
#'   essential genes (i.e. pan-lethal) so that they can be easily filtered.
#'   If provided, overrides the depmap essential genes.
#' @param depmap.db Optional character scalar for name of SQLite database returned by \code{\link{build_depmap_db}}.
#' @param genesets Optional named list containing genesets that can be interactively highlighted on the plots.
#'   The elements of the list should each be a geneset with gene identifiers matching those used in the results.
#' @param return.app Optional boolean indicating whether a Shiny app should be returned. \code{TRUE} by default. If \code{FALSE},
#'   a named list of app elements (ui and server) will be returned instead. Useful for deploying as a standalone shiny app.
#'
#' @return A Shiny app containing interactive visualizations of CRISPR analysis results.
#'
#' @rawNamespace import(shiny, except = c(dataTableOutput, renderDataTable))
#' @importFrom plotly ggplotly plotlyOutput renderPlotly toWebGL plot_ly layout add_annotations add_segments config toRGB event_data add_trace style
#' @importFrom shinyWidgets prettyCheckbox dropdownButton tooltipOptions pickerInput updatePickerInput
#' @importFrom shinycssloaders withSpinner
#' @importFrom shinyjqui jqui_resizable
#' @importFrom shinyjs show useShinyjs hidden disable click extendShinyjs js
#' @importFrom shinyBS tipify popify bsCollapse bsCollapsePanel
#' @importFrom colourpicker colourInput
#' @importFrom dittoSeq dittoColors
#' @importFrom grid grid.newpage grid.text
#' @importFrom stats cor as.formula
#' @importFrom utils read.csv read.delim
#'
#' @author Jared Andrews, Jacob Steele
#' @export
#' @examples
#' library(CRISPRball)
#' # Create app with no data loaded.
#' app <- CRISPRball()
#' if (interactive()) {
#'     shiny::runApp(app)
#' }
#'
#' # Create app with data loaded.
#' # Create lists of results summaries for each dataset.
#' d1.genes <- read.delim(system.file("extdata", "esc1.gene_summary.txt",
#'     package = "CRISPRball"
#' ), check.names = FALSE)
#' d2.genes <- read.delim(system.file("extdata", "plasmid.gene_summary.txt",
#'     package = "CRISPRball"
#' ), check.names = FALSE)
#'
#' d1.sgrnas <- read.delim(system.file("extdata", "esc1.sgrna_summary.txt",
#'     package = "CRISPRball"
#' ), check.names = FALSE)
#' d2.sgrnas <- read.delim(system.file("extdata", "plasmid.sgrna_summary.txt",
#'     package = "CRISPRball"
#' ), check.names = FALSE)
#'
#' count.summ <- read.delim(system.file("extdata", "escneg.countsummary.txt",
#'     package = "CRISPRball"
#' ), check.names = FALSE)
#' norm.counts <- read.delim(system.file("extdata", "escneg.count_normalized.txt",
#'     package = "CRISPRball"
#' ), check.names = FALSE)
#'
#' genes <- list(ESC = d1.genes, plasmid = d2.genes)
#' sgrnas <- list(ESC = d1.sgrnas, plasmid = d2.sgrnas)
#'
#' app <- CRISPRball(
#'     gene.data = genes, sgrna.data = sgrnas,
#'     count.summary = count.summ, norm.counts = norm.counts
#' )
#' if (interactive()) {
#'     shiny::runApp(app)
#' }
CRISPRball <- function(gene.data = NULL,
                       sgrna.data = NULL,
                       count.summary = NULL,
                       norm.counts = NULL,
                       h.id = "mag1",
                       positive.ctrl.genes = NULL,
                       essential.genes = NULL,
                       depmap.db = NULL,
                       genesets = NULL,
                       return.app = TRUE) {
    # Increase file upload size limit to 50MB, which should cover pretty much any use case.
    options(shiny.maxRequestSize = 50 * 1024^2)

    # Set initial metadata and dataset choices if input data isn't NULL.
    gene.choices <- NULL
    sgrna.choices <- NULL
    meta.choices <- NULL
    sgrna.gene <- NULL

    default.tab <- NULL

    if (!is.null(gene.data)) {
        gene.choices <- names(gene.data)
    }

    if (!is.null(sgrna.data)) {
        sgrna.choices <- names(sgrna.data)
        sgrna.gene <- unique(c(sgrna.data[[1]]$Gene))
    }

    if (!is.null(count.summary)) {
        meta.choices <- colnames(count.summary)
        default.tab <- "QC"
    }

    if (!is.null(norm.counts)) {
        default.tab <- "QC"
    }

    # Load cell line metadata, gene summaries, and release if depmap db provided.
    if (!is.null(depmap.db)) {
        .error_if_no_pool()
        .error_if_no_rsqlite()

        pool <- pool::dbPool(RSQLite::SQLite(), dbname = depmap.db)
        depmap.meta <- pool::dbGetQuery(pool, "SELECT * FROM 'meta'")
        depmap.gene <- pool::dbGetQuery(pool, "SELECT * FROM 'gene.summary'")
        depmap.release <- pool::dbGetQuery(pool, "SELECT * FROM 'release'")
        depmap.release <- depmap.release$depmap_release

        # Close db on app close.
        onStop(function() {
            pool::poolClose(pool)
        })
    } else {
        depmap.meta <- NULL
        depmap.gene <- NULL
        depmap.release <- NULL
        pool <- NULL
    }

    ui <- navbarPage(
        title = div(a(img(src = "logo/CRISPRball_Hex.png", height = "50"),
            href = "https://bioconductor.org/packages/CRISPRball"
        ), "CRISPRball"),
        selected = default.tab,
        header = list(
            useShinyjs(),
            extendShinyjs(text = .utils.js(), functions = c("disableTab", "enableTab")),
            css,
            tags$head(tags$link(rel = "shortcut icon", href = "logo/CRISPRball_Hex.png"))
        ),
        ## ---------------Data Upload-----------------
        .create_tab_data_upload(),
        ## ----------------QC--------------------
        .create_tab_qc(meta.choices),
        ## -------------------QC Table----------------
        .create_tab_qc_summary(),
        ## ------------------Gene (Overview)-------------
        .create_tab_gene(gene.choices, genesets),
        ## ----------------Gene Summary Tables--------------
        .create_tab_gene_summary(),
        ## ----------------sgRNA---------------------
        .create_tab_sgrna(sgrna.choices, sgrna.gene),
        ## --------------------sgRNA Summary Tables----------------
        .create_tab_sgrna_summary(),
        ## --------------------Dataset Comparisons----------------
        .create_tab_comparison(gene.choices),
        ## -----------------DepMap-------------------
        .create_tab_depmap(depmap.gene, depmap.meta),
        ## -----------------About-------------------
        .create_tab_about()
    )


    server <- function(input, output, session) {
        ## -------------Reactive Values---------------
        robjects <- reactiveValues(
            gene.data = gene.data,
            sgrna.data = sgrna.data,
            count.summary = count.summary,
            norm.counts = norm.counts,
            depmap.meta = depmap.meta,
            depmap.gene = depmap.gene,
            depmap.release = depmap.release,
            pool = pool,
            clicked.volc1 = NULL,
            clicked.rank1 = NULL,
            clicked.lawn1 = NULL,
            clicked.volc2 = NULL,
            clicked.rank2 = NULL,
            clicked.lawn2 = NULL,
            comps = list(),
            comp.neg.genes = list(),
            comp.pos.genes = list(),
            positive.ctrl.genes = positive.ctrl.genes,
            essential.genes = essential.genes,
            genesets = genesets,
            pc = NULL,
            h.id = h.id,
            plot.qc.pca = NULL,
            plot.qc.missed = NULL,
            plot.qc.gini = NULL,
            plot.qc.hist = NULL,
            plot.qc.corr = NULL,
            plot.qc.map = NULL,
            plot.gene1.vol = NULL,
            plot.gene1.rank = NULL,
            plot.gene1.lawn = NULL,
            plot.gene2.vol = NULL,
            plot.gene2.rank = NULL,
            plot.gene2.lawn = NULL,
            plot.sgrna1.counts = NULL,
            plot.sgrna1.rank = NULL,
            plot.depmap.essplot = NULL,
            plot.depmap.expplot = NULL,
            plot.depmap.cnplot = NULL,
            plot.depmap.lineages = NULL,
            plot.depmap.sublineage = NULL
        )

        # Create downloadHander outputs.
        .create_dl_outputs(output, robjects)

        ## --------------Disable Tabs-----------------
        defaultDisabledTabs <- c()

        if (is.null(gene.data)) {
            defaultDisabledTabs <- c(defaultDisabledTabs, "Gene (Overview)", "Gene Summary Tables")
        }

        if (length(gene.data) < 2) {
            defaultDisabledTabs <- c(defaultDisabledTabs, "Comparisons")
        }

        if (is.null(sgrna.data)) {
            defaultDisabledTabs <- c(defaultDisabledTabs, "sgRNA", "sgRNA Summary Tables")
        }

        if (is.null(count.summary) & is.null(norm.counts)) {
            defaultDisabledTabs <- c(defaultDisabledTabs, "QC", "QC Table")
        }

        if (is.null(count.summary)) {
            defaultDisabledTabs <- c(defaultDisabledTabs, "QC Table")
        }

        lapply(defaultDisabledTabs, function(tabname) js$disableTab(tabname))

        ## --------------Disable Inputs-----------------
        # Disable certain inputs if no data is provided.
        .create_ui_observers(robjects)

        ## ------------Data Upload Tab----------------
        # Create data upload observers.
        .create_upload_observers(input, session, robjects)

        ## -----------QC & QC Summary Tabs------------
        .create_qc_observers(input, robjects)

        .create_qc_outputs(input, output, robjects)

        # Initialize plots by simulating button click once.
        o <- observe({
            req(robjects$pca.mat)
            shinyjs::click("pca.update")
            o$destroy
        })

        ## ---------Gene (Overview) & Summary Tables Tabs-------------
        # Load the gene summaries for easy plotting.
        .create_gene_observers(input, robjects)

        # Summary tables and plots.
        .create_gene_outputs(input, output, robjects)

        # This ensures the rank options are updated even when initially hidden in the collapsible panel.
        outputOptions(output, "gene.term.options", suspendWhenHidden = FALSE)

        ## ---------------sgRNA & Summary Tables Tabs-----------------
        # Load the gene summaries for easy plotting.
        .create_sgrna_observers(input, robjects)

        # Summary tables and plots.
        .create_sgrna_outputs(input, output, robjects)

        ## --------------Comparisons Tab------------
        # UI elements for comparisons tab.
        .create_comparisons_outputs(input, output, robjects)

        # Create observers for comparisons tab, this is where upset plots are created as well.
        .create_comparisons_observers(input, session, output, robjects)

        # Initialize plots by simulating button click once.
        o <- observe({
            req(robjects$gene.data)
            shinyjs::click("comp.update")
            o$destroy
        })

        ## --------------DepMap Tab-----------------
        if (!is.null(depmap.gene)) {
            .create_depmap_outputs(input, output, robjects)
        }
    }

    if (return.app) {
        shinyApp(ui, server)
    } else {
        return(list(ui = ui, server = server))
    }
}