R/alevinQCShiny.R

In alevinQC: Generate QC Reports For Alevin Output

#' Generate alevin summary shiny app
#'
#' Generate a shiny app summarizing the main aspects of an alevin quantification
#' run. The app generation assumes that alevin has been run with the
#' --dumpFeatures flag to generate the necessary output files.
#'
#' @param baseDir Path to the output directory from the alevin run (should be
#'   the directory containing the \code{alevin} directory).
#' @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.
#'
#' @author Charlotte Soneson
#'
#' @export
#'
#' @import dplyr
#' @importFrom shiny fluidRow plotOutput renderPlot shinyApp
#' @importFrom shinydashboard dashboardPage dashboardHeader dashboardSidebar box
#' @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)
#' }
#'
alevinQCShiny <- function(baseDir, sampleId, customCBList = list()) {
    alevin <- readAlevinQC(baseDir, customCBList = customCBList)

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

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

        shinydashboard::dashboardSidebar(disable = TRUE),

        shinydashboard::dashboardBody(
            shiny::fluidRow(
                shinydashboard::box(
                    width = 6,
                    title = "Version info, alevin run",
                    DT::dataTableOutput("versionTable")
                ),
                shinydashboard::box(
                    width = 6,
                    title = "Summary tables",
                    DT::dataTableOutput("summaryTableFull"),
                    DT::dataTableOutput("summaryTableInitialWl"),
                    DT::dataTableOutput("summaryTableFinalWl"),
                    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 = "Quantification summary (initial whitelist)",
                    shiny::plotOutput("quantPlot"),
                    shiny::uiOutput("quantPlotsCustomCBs")
                )
            ),
            shiny::fluidRow(
                shinydashboard::box(
                    width = 12,
                    title = "Selected summary distributions (initial whitelist)",
                    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)
            )
        )

        ## ----------------------------------------------------------------- ##
        ## 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)
        )

        output$barcodeCollapsePlot <- shiny::renderPlot(
            plotAlevinBarcodeCollapse(alevin$cbTable)
        )

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

        ## ----------------------------------------------------------------- ##
        ## Standard quant plots
        ## ----------------------------------------------------------------- ##
        output$quantPlot <- shiny::renderPlot(
            plotAlevinQuant(alevin$cbTable, colName = "inFinalWhiteList",
                            cbName = "final whitelist")
        )

        ## ----------------------------------------------------------------- ##
        ## 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])
            )
        })

        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(
            cowplot::plot_grid(
                plotAlevinHistogram(alevin$cbTable, plotVar = "dedupRate",
                                    axisLabel = "Deduplication rate",
                                    colName = "inFinalWhiteList",
                                    cbName = "final whitelist"),
                plotAlevinHistogram(alevin$cbTable, plotVar = "mappingRate",
                                    axisLabel = "Mapping rate",
                                    colName = "inFinalWhiteList",
                                    cbName = "final whitelist")
            )
        )

        ## ----------------------------------------------------------------- ##
        ## 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)
            })
        })

    } # nocov end

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