R/alevinQCShiny.R

In csoneson/alevinQC: Generate QC Reports For Alevin Output

#' Generate alevin/alevin-fry summary shiny app
#'
#' Generate a shiny app summarizing the main aspects of an alevin/alevin-fry
#' quantification run. The app generation assumes that alevin has been run
#' with the --dumpFeatures flag to generate the necessary output files.
#'
#' @param baseDir (Only used for alevin output) Path to the output directory
#'     from the alevin run (should be the directory containing the
#'     \code{alevin} directory).
#' @param mapDir (Only used for alevin-fry output) Path to the output directory
#'     from the salmon alevin run (should be the directory containing the
#'     \code{map.rad} file).
#' @param permitDir (Only used for alevin-fry output) Path to the output
#'     directory from the permit list generation step (should be
#'     the directory containing the \code{all_freq.tsv} file).
#' @param quantDir (Only used for alevin-fry output) Path to the output
#'     directory from the alevin-fry quantification step (should be
#'     the directory containing the \code{alevin} directory).
#' @param simpleafQuantDir (Only used for simpleaf output) Path to the output
#'     directory from the simpleaf run (should be the directory containing the
#'     \code{af_map} and \code{af_quant} directories).
#' @param sampleId Sample ID, will be used set the title for the app.
#' @param customCBList Named list with custom set(s) of barcodes to provide
#'     summary statistics/plots for, in addition to the whitelists generated by
#'     alevin.
#' @param addStopButton Logical scalar. If \code{TRUE} (default), will add a
#'     dropdown menu with a button to stop the app (by calling
#'     \code{shiny::stopApp}) and return a list with the information displayed
#'     in the app.
#'
#' @author Charlotte Soneson
#'
#' @name qcShiny
#'
#' @import dplyr
#' @importFrom shiny fluidRow plotOutput renderPlot shinyApp actionButton icon
#'     stopApp observeEvent
#' @importFrom shinydashboard dashboardPage dashboardHeader dashboardSidebar
#'     box dropdownMenu notificationItem dropdownMenuOutput renderMenu
#' @importFrom DT dataTableOutput datatable renderDataTable
#' @importFrom utils packageVersion
#'
#' @return A shiny app.
#'
#' @examples
#' app <- alevinQCShiny(
#'     baseDir = system.file("extdata/alevin_example_v0.14",
#'                           package = "alevinQC"),
#'     sampleId = "example")
#' if (interactive()) {
#'     shiny::runApp(app)
#' }
#'
#' app <- alevinFryQCShiny(
#'     mapDir = system.file("extdata/alevinfry_example_v0.5.0/map",
#'                          package = "alevinQC"),
#'     permitDir = system.file("extdata/alevinfry_example_v0.5.0/permit",
#'                             package = "alevinQC"),
#'     quantDir = system.file("extdata/alevinfry_example_v0.5.0/quant",
#'                            package = "alevinQC"),
#'     sampleId = "example")
#' if (interactive()) {
#'     shiny::runApp(app)
#' }
#'
#' app <- simpleafQCShiny(
#'     simpleafQuantDir = system.file("extdata/alevinfry_example_piscem_v0.6.0",
#'                                    package = "alevinQC"),
#'     sampleId = "example")
#' if (interactive()) {
#'     shiny::runApp(app)
#' }
#'
NULL

#' @rdname qcShiny
#' @export
alevinQCShiny <- function(baseDir, sampleId, customCBList = list(),
                          addStopButton = TRUE) {
    .alevinQCShiny(baseDir = baseDir, mapDir = NULL, permitDir = NULL,
                   quantDir = NULL, quantMethod = "alevin", sampleId = sampleId,
                   customCBList = customCBList, addStopButton = addStopButton)
}

#' @rdname qcShiny
#' @export
alevinFryQCShiny <- function(mapDir, permitDir, quantDir, sampleId,
                             addStopButton = TRUE) {
    .alevinQCShiny(baseDir = NULL, mapDir = mapDir, permitDir = permitDir,
                   quantDir = quantDir, quantMethod = "alevin-fry",
                   sampleId = sampleId, customCBList = list(),
                   addStopButton = addStopButton)
}

#' @rdname qcShiny
#' @export
simpleafQCShiny <- function(simpleafQuantDir, sampleId, addStopButton = TRUE) {

    mapDir <- file.path(simpleafQuantDir, "af_map")
    permitDir <- file.path(simpleafQuantDir, "af_quant")
    quantDir <- file.path(simpleafQuantDir, "af_quant")

    if (!dir.exists(mapDir)) {
        stop("The provided simpleaf quant output directory doesn't contain ",
             "the `af_map` folder; Cannot proceed. Please run ",
             "alevinFryQCReport() and provide mapDir, permitDir, quantDir ",
             "explicitly. If produced by calling `simpleaf quant`, the ",
             "permitDir and `quantDir` is the same and is named as `af_quant` ",
             "under the simpleaf quant output directory.")
    }

    if (!dir.exists(quantDir)) {
        stop("The provided simpleaf quant output directory doesn't contain ",
             "the `af_quant` folder; Cannot proceed. Please run ",
             "alevinFryQCReport() and provide mapDir, permitDir, quantDir ",
             "explicitly. If produced by calling `simpleaf quant`, the ",
             "permitDir and `quantDir` is the same and is named as `af_quant` ",
             "under the simpleaf quant output directory.")
    }

    .alevinQCShiny(baseDir = NULL, mapDir = mapDir, permitDir = permitDir,
                   quantDir = quantDir, quantMethod = "alevin-fry",
                   sampleId = sampleId, customCBList = list(),
                   addStopButton = addStopButton)
}


#' @keywords internal
#' @noRd
.alevinQCShiny <- function(baseDir, mapDir, permitDir, quantDir,
                           quantMethod, sampleId, customCBList = list(),
                           addStopButton) {
    if (quantMethod == "alevin") {
        checkAlevinInputFiles(baseDir)
        alevin <- readAlevinQC(baseDir = baseDir, customCBList = customCBList)
        firstSelColName <- "inFirstWhiteList"
        wlName <- "initial whitelist"
        countCol <- "collapsedFreq"
    } else if (quantMethod == "alevin-fry") {
        checkAlevinFryInputFiles(mapDir = mapDir, permitDir = permitDir,
                                 quantDir = quantDir)
        alevin <- readAlevinFryQC(mapDir = mapDir, permitDir = permitDir,
                                  quantDir = quantDir)
        firstSelColName <- "inPermitList"
        wlName <- "permitlist"
        countCol <- "nbrMappedUMI"
    }



    pLayout <- shinydashboard::dashboardPage(
        skin = "red",

        shinydashboard::dashboardHeader(
            title = paste0("alevinQC (v",
                           utils::packageVersion("alevinQC"), "), ",
                           sampleId),
            titleWidth = (10 + nchar(sampleId)) * 20,
            shinydashboard::dropdownMenuOutput("stopAppMenu")
        ),

        shinydashboard::dashboardSidebar(disable = TRUE),

        shinydashboard::dashboardBody(
            shiny::fluidRow(
                shinydashboard::box(
                    width = 6,
                    title = paste0("Version info, ", quantMethod, " run"),
                    DT::dataTableOutput("versionTable")
                ),
                shinydashboard::box(
                    width = 6,
                    title = "Summary tables",
                    if (quantMethod == "alevin") DT::dataTableOutput("summaryTableFull"),
                    if (quantMethod == "alevin") DT::dataTableOutput("summaryTableInitialWl"),
                    if (quantMethod == "alevin") DT::dataTableOutput("summaryTableFinalWl"),
                    if (quantMethod == "alevin-fry") DT::dataTableOutput("summaryTablePl"),
                    shiny::uiOutput("summaryTablesCustomCBs")
                )

            ),
            shiny::fluidRow(
                shinydashboard::box(
                    width = 4,
                    title = "Knee plot, initial whitelist determination",
                    shiny::plotOutput("rawCBKneePlot")
                ),
                shinydashboard::box(
                    width = 4,
                    title = "Barcode collapsing",
                    shiny::plotOutput("barcodeCollapsePlot")
                ),
                shinydashboard::box(
                    width = 4,
                    title = "Knee plot, number of genes per cell",
                    shiny::plotOutput("nbrGenesKneePlot")
                )
            ),
            shiny::fluidRow(
                shinydashboard::box(
                    width = 12,
                    title = paste0("Quantification summary (", wlName, ")"),
                    shiny::plotOutput("quantPlot"),
                    shiny::uiOutput("quantPlotsCustomCBs")
                )
            ),
            shiny::fluidRow(
                shinydashboard::box(
                    width = 12,
                    title = paste0("Selected summary distributions (",
                                   wlName, ")"),
                    shiny::plotOutput("histPlot"),
                    shiny::uiOutput("histPlotsCustomCBs")
                )
            )

        )
    )

    server_function <- function(input, output, session) { # nocov start
        ## ----------------------------------------------------------------- ##
        ## Version table
        ## ----------------------------------------------------------------- ##
        output$versionTable <- DT::renderDataTable(
            DT::datatable(
                alevin$versionTable,
                colnames = "",
                options = list(scrollX = TRUE)
            )
        )

        ## ----------------------------------------------------------------- ##
        ## Standard summary tables
        ## ----------------------------------------------------------------- ##
        output$summaryTableFull <- DT::renderDataTable(
            DT::datatable(
                alevin$summaryTables$fullDataset,
                colnames = "",
                options = list(scrollX = TRUE)
            )
        )

        output$summaryTableInitialWl <- DT::renderDataTable(
            DT::datatable(
                alevin$summaryTables$initialWhitelist,
                colnames = "",
                options = list(scrollX = TRUE)
            )
        )

        output$summaryTableFinalWl <- DT::renderDataTable(
            DT::datatable(
                alevin$summaryTables$finalWhitelist,
                colnames = "",
                options = list(scrollX = TRUE)
            )
        )

        output$summaryTablePl <- DT::renderDataTable(
            DT::datatable(
                alevin$summaryTables$permitlist,
                colnames = "",
                options = list(scrollX = TRUE)
            )
        )

        ## ----------------------------------------------------------------- ##
        ## Custom CB summary tables
        ## ----------------------------------------------------------------- ##
        lapply(seq_along(customCBList), function(i) {
            id <- paste0("dt", i)
            output[[id]] <- DT::renderDataTable(
                DT::datatable(
                    alevin$summaryTables[[paste0("customCB__",
                                                 names(customCBList)[i])]],
                    colnames = "",
                    options = list(scrollX = TRUE)
                )
            )
        })

        output$summaryTablesCustomCBs <- shiny::renderUI({
            lapply(as.list(seq_along(customCBList)), function(i) {
                id <- paste0("dt", i)
                DT::dataTableOutput(id)
            })
        })

        ## ----------------------------------------------------------------- ##
        ## Standard plots
        ## ----------------------------------------------------------------- ##
        output$rawCBKneePlot <- shiny::renderPlot(
            plotAlevinKneeRaw(alevin$cbTable, firstSelColName = firstSelColName)
        )

        output$barcodeCollapsePlot <- shiny::renderPlot(
            plotAlevinBarcodeCollapse(alevin$cbTable,
                                      firstSelColName = firstSelColName,
                                      countCol = countCol)
        )

        output$nbrGenesKneePlot <- shiny::renderPlot(
            plotAlevinKneeNbrGenes(alevin$cbTable,
                                   firstSelColName = firstSelColName)
        )

        ## ----------------------------------------------------------------- ##
        ## Standard quant plots
        ## ----------------------------------------------------------------- ##
        output$quantPlot <- shiny::renderPlot(
            if (quantMethod == "alevin") {
                plotAlevinQuant(alevin$cbTable, colName = "inFinalWhiteList",
                                cbName = "final whitelist",
                                firstSelColName = firstSelColName)
            } else if (quantMethod == "alevin-fry") {
                plotAlevinQuant(alevin$cbTable, colName = "inPermitList",
                                cbName = "permitlist",
                                firstSelColName = firstSelColName)

            }
        )

        ## ----------------------------------------------------------------- ##
        ## Custom CB quant plots
        ## ----------------------------------------------------------------- ##
        lapply(seq_along(customCBList), function(i) {
            id <- paste0("qpl", i)
            output[[id]] <- shiny::renderPlot(
                plotAlevinQuant(alevin$cbTable,
                                colName = paste0("customCB__",
                                                 names(customCBList)[i]),
                                cbName = names(customCBList)[i],
                                firstSelColName = firstSelColName)
            )
        })

        output$quantPlotsCustomCBs <- shiny::renderUI({
            lapply(as.list(seq_along(customCBList)), function(i) {
                id <- paste0("qpl", i)
                shiny::plotOutput(id)
            })
        })

        ## ----------------------------------------------------------------- ##
        ## Standard distribution plots
        ## ----------------------------------------------------------------- ##
        output$histPlot <- shiny::renderPlot(
            if (quantMethod == "alevin") {
                cowplot::plot_grid(
                    plotAlevinHistogram(alevin$cbTable, plotVar = "dedupRate",
                                        axisLabel = "Deduplication rate",
                                        colName = "inFinalWhiteList",
                                        cbName = "final whitelist",
                                        firstSelColName = firstSelColName),
                    plotAlevinHistogram(alevin$cbTable, plotVar = "mappingRate",
                                        axisLabel = "Mapping rate",
                                        colName = "inFinalWhiteList",
                                        cbName = "final whitelist",
                                        firstSelColName = firstSelColName)
                )
            } else if (quantMethod == "alevin-fry") {
                cowplot::plot_grid(
                    plotAlevinHistogram(alevin$cbTable, plotVar = "dedupRate",
                                        axisLabel = "Deduplication rate",
                                        colName = firstSelColName,
                                        cbName = "permitlist",
                                        firstSelColName = firstSelColName),
                    plotAlevinHistogram(alevin$cbTable, plotVar = "mappingRate",
                                        axisLabel = "Mapping rate",
                                        colName = firstSelColName,
                                        cbName = "permitlist",
                                        firstSelColName = firstSelColName)
                )

            }
        )

        ## ----------------------------------------------------------------- ##
        ## Custom CB distribution plots
        ## ----------------------------------------------------------------- ##
        lapply(seq_along(customCBList), function(i) {
            id <- paste0("hpl", i)
            output[[id]] <- shiny::renderPlot(
                cowplot::plot_grid(
                    plotAlevinHistogram(
                        alevin$cbTable, plotVar = "dedupRate",
                        axisLabel = "Deduplication rate",
                        colName = paste0("customCB__",
                                         names(customCBList)[i]),
                        cbName = names(customCBList)[i]),
                    plotAlevinHistogram(
                        alevin$cbTable, plotVar = "mappingRate",
                        axisLabel = "Mapping rate",
                        colName = paste0("customCB__",
                                         names(customCBList)[i]),
                        cbName = names(customCBList)[i])
                )
            )
        })

        output$histPlotsCustomCBs <- shiny::renderUI({
            lapply(as.list(seq_along(customCBList)), function(i) {
                id <- paste0("hpl", i)
                shiny::plotOutput(id)
            })
        })

        ## ----------------------------------------------------------------- ##
        ## Close and return button
        ## ----------------------------------------------------------------- ##
        output$stopAppMenu <- shinydashboard::renderMenu(
            if (addStopButton) {
                shinydashboard::dropdownMenu(
                    type = "tasks",
                    icon = shiny::icon("circle-xmark"),
                    badgeStatus = NULL,
                    headerText = "",
                    shinydashboard::notificationItem(
                        text = shiny::actionButton(
                            inputId = "close_app", label = "Close app",
                            icon = shiny::icon("circle-xmark")
                        ),
                        icon = shiny::icon(""), # tricking it to not have additional icon
                        status = "primary"
                    )
                )
            } else {
                NULL
            }
        )
        shiny::observeEvent(input$close_app, {
            shiny::stopApp(returnValue = list(alevin = alevin,
                                              firstSelColName = firstSelColName,
                                              wlName = wlName,
                                              countCol = countCol))
        })

    } # nocov end

    shiny::shinyApp(ui = pLayout, server = server_function)
}