inst/app/R/tab_vs_data_countmatrix.R

In systemPipeR/spsBio: spsBio: A systemPipeShiny plugin for biological data visualization

#########################################################
## UI: data_countmatrixUI
#########################################################
#' @importFrom DT DTOutput
#' @importFrom shinyWidgets radioGroupButtons pickerInput
#' @noRd

data_countmatrixUI <- function(id){
    ns <- NS(id)
    # describe tab 
    desc <- "
    #### Introduction
        Each row of the Count Matrix represents the number of reads overlapping a given 
        feature such as a gene and each column indicates one sample."
    tagList(
        pgPaneUI(ns("pg"),
                 titles = c("Package Requirements", "Data Loaded",
                            "Input Data Validation", "Preprocess"),
                 pg_ids = c(ns("pkg"), ns("data"), ns("vd_data"), ns("prepro"))
        ),
        tabTitle("Count Matrix Input"), spsHr(),
        renderDesc(id = ns("desc"), desc),
        div(style = "text-align: center;",
            actionButton(inputId = ns("validate_start"),
                         label = "Start this tab")
        ),
        div(
            id = ns("tab_main"), class = "shinyjs-hide",
            shinyWidgets::radioGroupButtons(
                inputId = ns("data_source"),
                label = "Choose your Count Matrix file source:",
                selected = "upload",
                choiceNames = c("Upload", "Example"),
                choiceValues = c("upload", "eg"),
                justified = TRUE, status = "primary",
                checkIcon = list(yes = icon("ok", lib = "glyphicon"),
                                 no = icon(""))
            ),
            fluidRow(
                column(width = 5, dynamicFile(id = ns("file_upload"))),
                column(width = 3,
                       shinyWidgets::pickerInput(
                           inputId = ns("delim"), label = "File delimiter",
                           choices = c(Tab="\t", `,`=",", space=" ",
                                       `|`="|", `:`=":", `;`=";"),
                           options = list(style = "btn-primary")
                )),
                column(
                    width = 3,
                    clearableTextInput(
                        ns("comment"), "File comments", value = "#")
                    )
            ),
            div(h4("Count Matrix", style="text-align: left;")),
            div(style = "background-color: #F1F1F1;", DT::DTOutput(ns("df"))),
            div(h4("Choose a proprocessing method", style="text-align: left;"),
                p("Depending on different ways of preprocessing,
                  different plotting options will be available")),
            fluidRow(
                #hr(), 
                column(4,
                       shinyWidgets::pickerInput(
                           inputId = ns("select_prepro"),
                           choices = c(`Raw Count Reads`='raw',
                                       `Method rlog`='rlog',
                                       `Method vst`='vst'),
                           options = list(style = "btn-primary")
                       )
                ),
                column(2,
                       actionButton(ns("preprocess"),
                                    label = "Preprocess",
                                    icon("paper-plane"))
                )
            ),
            fluidRow(id = ns("plot_option_row"), class = "shinyjs-hide",
                     uiOutput(ns("plot_option"))
            )
        )
    )
}

#########################################################
## Server: data_countmatrixServer
#########################################################
#' @importFrom DT renderDT datatable
#' @importFrom shiny validate
#' @importFrom shinyjs show hide toggleState
#' @importFrom shinytoastr toastr_success
#' @importFrom methods is
#' @noRd

data_countmatrixServer <-function(id, shared){
    module <- function(input, output, session){
        ns <- session$ns
        tab_id <- "data_countmatrix"
        # start the tab by checking if required packages are installed
        observeEvent(input$validate_start, {
            req(shinyCheckPkg(
                session = session,
                cran_pkg = c("base"),
                bioc_pkg = c(""),
                github = c("")
            ))
            shinyjs::show(id = "tab_main")
            shinyjs::hide(id = "validate_start")
            pgPaneUpdate('pg', 'pkg', 100) # update progress
        })
        observeEvent(input$data_source,
                     shinyjs::toggleState(id = "file_upload"),
                     ignoreInit = TRUE)
        # get upload path, note path is in upload_path()$datapath
        upload_path <- dynamicFileServer(input,
                                         session,
                                         id = "file_upload") # this is reactive
        # load the file dynamically
        data_df <- reactive({
            data_path <- upload_path()
            pgPaneUpdate('pg', 'data', 0) # set data progress to 0 every reload
            loadDF(choice = input$data_source, upload_path = data_path$datapath,
                   delim = input$delim, comment = input$comment,
                   eg_path = system.file("extdata", "countDFeByg.xls", package = "systemPipeR"))
        })
        # display table
        output$df <- DT::renderDT({
            shiny::validate(
                need(not_empty(data_df()), message = "Data file is not loaded")
            )
            pgPaneUpdate('pg', 'data', 100)
            DT::datatable(
                data_df(),
                style = "bootstrap",
                class = "compact",  filter = "top",
                extensions = c( 'Scroller','Buttons'),
                # options = list(
                #     dom = 'Bfrtip',
                #   #  buttons = c('copy', 'csv', 'excel'),
                #     deferRender = TRUE,
                #     scrollY = 580, scrollX = TRUE, scroller = TRUE,
                #     columnDefs = list(list(className = 'dt-center',
                #                            targets = "_all"))
                # )
                )
        })
        # start validation and preprocess
        observeEvent(input$preprocess, ignoreInit = TRUE, {
            # get filtered df
            data_filtered <-  data_df()[input$df_rows_all, ]
            # validate data
            spsValidate({
                if (is(data_filtered, "data.frame")) TRUE
                else stop("Input data is not a dataframe")
                if (ncol(data_filtered) >= 1) TRUE
                else stop("Data need to have at least one column")
            }, "Data common checks")
            # validate special requirements for different preprocess methods
            switch(
                input$select_prepro,
                'raw' = spsValidate({
                    if (nrow(data_filtered) >= 1) TRUE
                    else stop("Data need to have at least one row")
                }, "Requirements for method 1"),
                'rlog' = spsValidate({
                    if (nrow(data_filtered) >= 1) TRUE
                    else stop("Data need to have at most 1000 rows")
                }, "Requirements for method 2"),
                msg('No addition validation required')
            )
            pgPaneUpdate('pg', 'vd_data', 100)
            # if validation passed, start reprocess
            targetspath <- system.file("extdata", "targets.txt", package="systemPipeR")
            targets <- read.delim(targetspath, comment="#")
            cmp <- systemPipeR::readComp(file=targetspath, format="matrix", delim="-")
            data_filtered <- tibble::column_to_rownames(data_filtered, var = "...1")
            data_processed <- shinyCatch(
                switch(input$select_prepro,
                       'raw' = {
                           # your preprocess function, e.g
                           exploredds <- exploreDDS(data_filtered, targets, cmp=cmp[[1]],
                                                    preFilter=NULL, transformationMethod="raw")
                       },
                       'vst' = {
                           # your preprocess function, e.g
                           exploredds <- exploreDDS(data_filtered, targets, cmp=cmp[[1]],
                                                    preFilter=NULL, transformationMethod="vst")
                       },
                       'rlog' = {
                           # your preprocess function, e.g
                           exploredds <- exploreDDS(data_filtered, targets, cmp=cmp[[1]],
                                                    preFilter=NULL, transformationMethod="rlog")
                       },
                       data_filtered
            ), blocking_level = 'error')
            spsValidate(not_empty(data_processed), "Final data is not empty")
            pgPaneUpdate('pg', 'prepro', 100)
            # add data to task
            addData(data_processed, shared, tab_id)
            shinytoastr::toastr_success(
                title = "Preprocess done!",
                message = "You can choose your plot options below",
                timeOut = 5000,
                position = "bottom-right"
            )
            shinyjs::show(id = "plot_option_row")
            gallery <- switch(
                input$select_prepro,
                'raw' = genGallery(c("plot_MA", "plot_GLM")),
                'rlog' = genGallery(c("plot_PCA", "plot_hclust", "plot_MDS", "plot_heatmap")),
                'vst' = genGallery(c("plot_PCA", "plot_hclust", "plot_MDS", "plot_heatmap")),
                genGallery(type = "plot")
            )
            output$plot_option <- renderUI({
                gallery
            })
        })
    }
    moduleServer(id, module)
}