R/dash_expr_server.R

In alexchwong/SpliceWiz: interactive analysis and visualization of alternative splicing in R

server_expr <- function(
        id, refresh_tab, volumes, get_threads_reactive, 
        get_memmode_reactive,
        limited = FALSE
) {
    moduleServer(id, function(input, output, session) {
        ns <- NS(id)
        
        # Instantiate settings
        settings_expr <- setreactive_expr()

        # Directory and file handling
        observe({
            # Folder select
            shinyDirChoose(input, "dir_reference_path_load", 
                roots = volumes(), session = session)
            shinyDirChoose(input, "dir_bam_path_load", 
                roots = volumes(), session = session)
            shinyDirChoose(input, "dir_NxtSE_path_load", 
                roots = volumes(), session = session)

            # Anno i/o from csv / tables
            shinyFileChoose(input, "file_expr_anno_load", 
                roots = volumes(), session = session)
            shinyFileSave(input, "anno_as_csv", 
                roots = volumes(), session = session, filetypes = c("csv"))

            # NxtSE as RDS
            shinyFileChoose(input, "loadNxtSE_RDS", 
                roots = volumes(), session = session, filetype = c("Rds"))
            shinyFileSave(input, "saveNxtSE_RDS", roots = volumes(), 
                session = session, filetypes = c("rds"))    
        })
        
        # Directory path getters
        observeEvent(input$dir_reference_path_load, {
            req(input$dir_reference_path_load)
            settings_expr$ref_path <- parseDirPath(volumes(), 
                input$dir_reference_path_load)
        })
        observeEvent(input$dir_bam_path_load, {
            req(input$dir_bam_path_load)
            settings_expr$bam_path <- parseDirPath(volumes(), 
                input$dir_bam_path_load)
        })
        observeEvent(input$dir_NxtSE_path_load, {
            req(input$dir_NxtSE_path_load)
            settings_expr$NxtSE_path <- parseDirPath(volumes(), 
                input$dir_NxtSE_path_load)
            req(settings_expr$NxtSE_path)
            req(dir.exists(settings_expr$NxtSE_path))
            
            pbPath <- file.path(settings_expr$NxtSE_path, "pbOutput")
            if(!dir.exists(pbPath)) dir.create(pbPath)
            settings_expr$df.files <- Expr_Load_SW(
                settings_expr$df.files, pbPath)
        })
        
        # Experiment I/O - sync between files and anno
        observeEvent(settings_expr$df.files, {
            req(settings_expr$df.files)
            req(is(settings_expr$df.files, "data.frame"))
            req("sample" %in% colnames(settings_expr$df.files))
            if(
                is_valid(settings_expr$disallow_df_update) &&
                settings_expr$disallow_df_update
            ) {
                settings_expr$disallow_df_update <- FALSE
            } else {
                settings_expr$df.anno <- .server_expr_sync_df(
                    settings_expr$df.files, settings_expr$df.anno)            
            }
        })
        observeEvent(settings_expr$df.anno, {
            req(settings_expr$df.anno)
            req(is(settings_expr$df.anno, "data.frame"))
            req("sample" %in% colnames(settings_expr$df.anno))
            req(settings_expr$df.files)
            if(
                !is_valid(settings_expr$disallow_df_update) ||
                !settings_expr$disallow_df_update
            ) {
                settings_expr$df.files <- .server_expr_sync_df(
                    settings_expr$df.anno, settings_expr$df.files)
            }
        })
        
        # Experiment I/O - sync between user input and data frames
        observeEvent(input$hot_ref_expr,{
            req(input$hot_ref_expr)
            settings_expr$ref_table <- hot_to_r(input$hot_ref_expr) 
        })
        observeEvent(input$hot_bams_expr,{
            req(input$hot_bams_expr)
            settings_expr$df.bams <- hot_to_r(input$hot_bams_expr) 
        })
        observeEvent(input$hot_files_expr,{
            req(input$hot_files_expr)
            settings_expr$df.files <- hot_to_r(input$hot_files_expr) 
        })
        observeEvent(input$hot_anno_expr,{
            req(input$hot_anno_expr)
            settings_expr$df.anno <- hot_to_r(input$hot_anno_expr)
        })
        
        output$hot_files_expr <- renderRHandsontable({
            .server_expr_gen_HOT(settings_expr$df.files)
        })
        output$hot_anno_expr <- renderRHandsontable({
            .server_expr_gen_HOT(settings_expr$df.anno)
        })
        output$hot_bams_expr <- renderRHandsontable({
            .server_expr_gen_HOT(settings_expr$df.bams,
                lockedColumns = "path")
        })
        output$hot_ref_expr <- renderRHandsontable({
            .server_expr_gen_HOT(settings_expr$ref_table,
                lockedColumns = c("parameter", "value"))
        })

        observeEvent(input$anno_to_NxtSE, {
            req(input$anno_to_NxtSE)
            req(settings_expr$NxtSE_path)

            outFile <- file.path(settings_expr$NxtSE_path, "colData.Rds")
            req(file.exists(outFile))

            colData.Rds <- list(
                df.anno = settings_expr$df.anno,
                df.files = settings_expr$df.files
            )
            saveRDS(colData.Rds, outFile)
            settings_expr$df.files_savestate <- settings_expr$df.files
            settings_expr$df.anno_savestate <- settings_expr$df.anno
        })
        
        observeEvent(input$anno_from_NxtSE, {
            req(input$anno_from_NxtSE)
            req(settings_expr$NxtSE_path)

            inFile <- file.path(settings_expr$NxtSE_path, "colData.Rds")
            req(file.exists(inFile))

            colData.Rds <- readRDS(inFile)
            req_columns <- c("df.anno", "df.files")
            if(all(req_columns %in% names(colData.Rds))) {
                settings_expr$disallow_df_update <- TRUE
                settings_expr$df.files <- colData.Rds$df.files
                settings_expr$df.files_savestate <- settings_expr$df.files
                settings_expr$df.anno <- colData.Rds$df.anno
                settings_expr$df.anno_savestate <- settings_expr$df.anno
            }
        })


    # Edit Annotations
        observeEvent(input$add_anno, {
            req(input$add_anno)
            updateRadioGroupButtons(session, inputId = "hot_switch_expr", 
                selected = "Annotations")
        })
        output$newcol_expr <- renderUI({
            textInput(ns("newcolumnname_expr"), "Column Name (to add / remove)", 
                sprintf("newcol%s", 1 + ncol(settings_expr$df.anno))
            )
        })
        # Add new annotation column
        observeEvent(input$addcolumn_expr, {
            req(input$addcolumn_expr)
            df <- isolate(settings_expr$df.anno)
            newcolumn <- eval(parse(text=sprintf('%s(nrow(df))', 
                isolate(input$type_newcol_expr))))
            settings_expr$df.anno <- data.table::setnames(
                cbind(df, newcolumn, stringsAsFactors=FALSE), 
                c(names(df), isolate(input$newcolumnname_expr))
            )
        })
        # Remove annotation column
        observeEvent(input$removecolumn_expr, {
            req(input$removecolumn_expr)
            DT <- as.data.table(isolate(settings_expr$df.anno))
            if(isolate(input$newcolumnname_expr) %in% colnames(DT)) {
                message("removing column")
                DT[, c(input$newcolumnname_expr) := NULL]
                settings_expr$df.anno <- as.data.frame(DT)
            }
        })
        
    # Clearing Selections
        observeEvent(input$clearLoadRef,{
            settings_expr$ref_path <- ""
        })
        observeEvent(input$clear_expr, {
            settings_expr$ref_path <- ""
            settings_expr$bam_path <- ""
            settings_expr$NxtSE_path <- ""
            settings_expr$anno_file <- ""
            settings_expr$df.bams <- c()
            settings_expr$df.files <- c()
            settings_expr$df.anno <- c()
            settings_expr$se <- NULL
        })    
        
        # Event when reference directory is set
        observeEvent(settings_expr$ref_path, {
            if(
                is_valid(settings_expr$ref_path)
            ) {
                settingsFile <- file.path(
                    settings_expr$ref_path, "settings.Rds")
                if(file.exists(settingsFile)) {
                    settings_expr$ref_settings <- readRDS(settingsFile)
                } else {
                    settings_expr$ref_settings <- NULL
                }
            } else {
                settings_expr$ref_settings <- NULL
            }
        })
        output$txt_reference_path_load <- renderText(settings_expr$ref_path)

        # Load settings values if ref_settings is filled
        observeEvent(settings_expr$ref_settings, {
            df <- data.frame()
            rsList <- settings_expr$ref_settings
            if(is_valid(rsList) && is.list(rsList)) {
                df <- data.frame(
                    parameter = names(rsList),
                    value = ""
                )
                for(i in seq_len(nrow(df))) {
                    df$value[i] <- rsList[[df$parameter[i]]]
                }
            }
            settings_expr$ref_table <- df
            updateRadioGroupButtons(session, inputId = "hot_switch_expr", 
                selected = "ref")
        })
        # Event when BAM directory is set
        observeEvent(settings_expr$bam_path,{
            settings_expr$df.bams <- .addBAMfiles(
                isolate(settings_expr$df.bams),
                settings_expr$bam_path
            )
            req(settings_expr$df.bams)
            updateRadioGroupButtons(session, inputId = "hot_switch_expr", 
                selected = "BAMs")
        })
        output$txt_bam_path_load <- renderText(settings_expr$bam_path)

        # Event when processBAM output directory is set
        observeEvent(settings_expr$NxtSE_path,{
            settings_expr$df.files <- c()
            settings_expr$df.anno <- c()
            settings_expr$df.files_savestate <- c()
            settings_expr$df.anno_savestate <- c()
            
            req(is_valid(settings_expr$NxtSE_path))

            # Load NxtSE if colData.Rds exists
            colData_path <- file.path(settings_expr$NxtSE_path, "colData.Rds")
            if(file.exists(colData_path)) {
                colData.Rds <- readRDS(colData_path)
                if(all(c("df.anno", "df.files") %in% names(colData.Rds))) {
                    settings_expr$df.files <- colData.Rds$df.files
                    settings_expr$df.anno <- colData.Rds$df.anno
                    settings_expr$df.files_savestate <- settings_expr$df.files
                    settings_expr$df.anno_savestate <- settings_expr$df.anno
                }
            }

            # Add new files if not already exist
            pbPath <- file.path(settings_expr$NxtSE_path, "pbOutput")
            settings_expr$df.files <- Expr_Load_SW(
                settings_expr$df.files, pbPath)
        })
        output$txt_NxtSE_path_load <- renderText(settings_expr$NxtSE_path)

        # Open / merge annotation file with current annotations
        observeEvent(input$file_expr_anno_load, {
            req(input$file_expr_anno_load)
            file_selected <- parseFilePaths(volumes(),
                input$file_expr_anno_load)
            req(file_selected$datapath)
            settings_expr$anno_file <- as.character(file_selected$datapath)
        })
        observeEvent(settings_expr$anno_file,{
            req(settings_expr$anno_file)
            req(file.exists(settings_expr$anno_file))
            settings_expr$df.anno <- Expr_Load_Anno(settings_expr$df.anno,
                settings_expr$df.files, settings_expr$anno_file, session)
            updateRadioGroupButtons(session, inputId = "hot_switch_expr", 
                selected = "Annotations")
        })
        
        # Export annotations as csv
        observeEvent(input$anno_as_csv, {
            selectedfile <- parseSavePath(volumes(), input$anno_as_csv)
            req(selectedfile$datapath)
            req(settings_expr$df.anno)
            
            fwrite(settings_expr$df.anno, selectedfile$datapath)
        })

        # Running processBAM
        observeEvent(input$run_pb_expr,{
            req(input$run_pb_expr)
            settings_expr$selected_bams <- Expr_PB_initiate_run(
                input, session, 
                input$pbam_threads, # get_threads_reactive(), 
                isolate(reactiveValuesToList(settings_expr))
            )
        })
        observeEvent(input$pb_confirm, {
            if(input$pb_confirm == FALSE) {
                settings_expr$selected_bams <- c()
            } else {
                Expr_PB_actually_run(
                    input, session, 
                    input$pbam_threads, # get_threads_reactive(),
                    isolate(reactiveValuesToList(settings_expr))
                )
                settings_expr$selected_bams <- c()
                settings_expr$df.bams$selected <- FALSE

                pbPath <- file.path(settings_expr$NxtSE_path, "pbOutput")        
                settings_expr$df.files <- Expr_Load_SW(
                    settings_expr$df.files, pbPath)
                updateRadioGroupButtons(session, inputId = "hot_switch_expr", 
                    selected = "Files")
            }
        })

        # Running collateData
        observeEvent(input$run_collate_expr, {
            req(input$run_collate_expr)
            req(settings_expr$df.files)
            Experiment <- na.omit(as.data.table(
                settings_expr$df.files[, c("sample", "sw_file", "cov_file")]
            ))
            reference_path <- settings_expr$ref_path
            output_path <- settings_expr$NxtSE_path
            if(Expr_collateData_Validate_Vars(
                    session, Experiment, reference_path, output_path
            )) {
                args <- list(
                    Experiment = Experiment,
                    reference_path = reference_path,
                    output_path = output_path,
                    lowMemoryMode = input$mem_mode,
                    novelSplicing = input$novel_splicing_on,
                    novelSplicing_requireOneAnnotatedSJ = 
                        input$novel_splicing_sameJunc,
                    novelSplicing_minSamples = input$nsOpt_minSamples,
                    novelSplicing_minSamplesAboveThreshold = 
                        input$nsOpt_minSamplesThreshold,
                    novelSplicing_countThreshold  = input$nsOpt_Threshold,
                    novelSplicing_useTJ = input$nsOpt_TJ,
                    overwrite = input$NxtSE_overwrite
                )
                settings_expr$collateData_args <- Expr_cD_initiate_run(
                    input, session, 
                    input$cd_threads, # get_threads_reactive(),
                    args
                )
            }
        })
        observeEvent(input$cD_confirm, {
            if(input$cD_confirm == FALSE) {
                settings_expr$collateData_args <- NULL
            } else {
                Expr_cD_actually_run(
                    input, session, 
                    input$cd_threads, # get_threads_reactive(),
                    isolate(reactiveValuesToList(settings_expr))
                )
                settings_expr$collateData_args <- NULL

                # Synch is collateData run is successful
                colData_path <- file.path(
                    settings_expr$NxtSE_path, "colData.Rds")
                if(file.exists(colData_path)) {
                    colData.Rds <- readRDS(colData_path)
                    if(all(c("df.anno", "df.files") %in% names(colData.Rds))) {
                        # settings_expr$df.files <- colData.Rds$df.files
                        # settings_expr$df.anno <- colData.Rds$df.anno
                        settings_expr$df.files_savestate <- settings_expr$df.files
                        settings_expr$df.anno_savestate <- settings_expr$df.anno
                    }
                }

            }
        })


    ## Status boxes

        output$ref_expr_infobox <- renderUI({
            ref_path <- settings_expr$ref_path
            ref_settings_file <- ""
            if(is_valid(ref_path)) {
                ref_settings_file <- file.path(ref_path, "settings.Rds")
            }
            ui_infobox_ref(ref_settings_file)
        })
        
        allBAMpaths_r <- reactive({
            if(!is_valid(settings_expr$df.bams)) return(NULL)
            if(!("path" %in% colnames(settings_expr$df.bams))) return(NULL)
            return(settings_expr$df.bams$path)
        })
        allBAMnames_r <- reactive({
            if(!is_valid(settings_expr$df.bams)) return(NULL)
            if(!("sampleName" %in% colnames(settings_expr$df.bams))) return(NULL)
            return(settings_expr$df.bams$sampleName)
        })
        output$bam_expr_infobox <- renderUI({
            if(
                is_valid(settings_expr$df.files) &&
                all(allBAMnames_r() %in% settings_expr$df.files$sample)
            ) {
                ui_infobox_bam(escape = TRUE)
            } else if(!is.null(allBAMpaths_r())) {
                ui_infobox_bam(settings_expr$bam_path,
                    allBAMpaths_r())
            } else {
                ui_infobox_bam(settings_expr$bam_path)
            }
        })

        anno_nCol <- reactive({
            if(!is_valid(settings_expr$df.anno)) return(0)
            return(ncol(settings_expr$df.anno))
        })
        isExprReadyToCollate <- reactive({
            if(!is_valid(settings_expr$NxtSE_path)) return(FALSE)
            if(!is_valid(settings_expr$df.files)) return(FALSE)
            if(!all(file.exists(settings_expr$df.files$sw_file))) return(FALSE)
            if(!is_valid(settings_expr$df.bams)) return(TRUE)
            if(
                "sampleName" %in% colnames(settings_expr$df.bams) &&
                all(
                    settings_expr$df.bams$sampleName %in%
                        settings_expr$df.files$sample
                )
            ) return(TRUE)
            return(FALSE)
        })
        anyBAMsNeedProcessing <- reactive({
            if(!is_valid(settings_expr$NxtSE_path)) return(FALSE)
            if(!is_valid(settings_expr$df.files)) return(FALSE)
            if(!is_valid(settings_expr$df.bams)) return(FALSE)
            if(!("sample" %in% colnames(settings_expr$df.files))) return(FALSE)
            if(!("sampleName" %in% colnames(settings_expr$df.bams))) return(FALSE)
            if(all(
                settings_expr$df.bams$sampleName %in% 
                settings_expr$df.files$sample
            )) return(FALSE)
            return(TRUE)
        })
        allBAMsNeedProcessing <- reactive({
            if(!is_valid(settings_expr$NxtSE_path)) return(FALSE)
            if(is_valid(settings_expr$df.files)) return(FALSE)
            return(TRUE)
        })
        isAnnoSavedToNxtSE <- reactive({
            if(!is_valid(settings_expr$NxtSE_path)) return(FALSE)
            if(!is_valid(settings_expr$df.files)) return(FALSE)
            if(!is_valid(settings_expr$df.anno)) return(FALSE)
            if(!is_valid(settings_expr$df.files_savestate)) return(FALSE)
            if(!is_valid(settings_expr$df.anno_savestate)) return(FALSE)
            return(
                identical(settings_expr$df.anno_savestate, settings_expr$df.anno) &&
                identical(settings_expr$df.files_savestate, settings_expr$df.files)
            )            
        })
        infoboxSE_decision <- reactive({
            tmp <- settings_expr$collateData_args
            
            if(
                is_valid(settings_expr$NxtSE_path) &&
                file.exists(file.path(settings_expr$NxtSE_path, "seed.Rds"))
            ) {
                if(limited) {
                    if(is(settings_expr$se, "NxtSE")) {
                        return(ui_infobox_expr(3, "NxtSE ready to analyse", 
                            "", limited))
                    } else if(anno_nCol() > 1) {
                        return(ui_infobox_expr(2, "NxtSE ready to load", 
                    "Click `Load NxtSE from folder`", limited))
                    } else {
                        return(ui_infobox_expr(1, "NxtSE missing annotations", 
                    "Consider adding annotations to your experiment", limited))
                    }
                } else {
                    savedNxtSE <- isAnnoSavedToNxtSE()
                    if(savedNxtSE) {
                        return(ui_infobox_expr(3, "NxtSE ready to load", 
                    "Load via Analysis -> Load Experiment", limited))
                    } else {
                        return(ui_infobox_expr(2, "NxtSE ready to load", 
                    "Don't forget to save your annotations", limited))
                    }                
                }
            } else if(isExprReadyToCollate()) {
                return(ui_infobox_expr(2, "Ready to collate experiment", "", limited))
            } else if(anyBAMsNeedProcessing()) {
                return(ui_infobox_expr(1,
                    "Some BAM files need to be processed", "", limited))
            } else if(allBAMsNeedProcessing()) {
                return(ui_infobox_expr(1,
                    "BAM files need to be processed", "", limited))
            } else if(is_valid(settings_expr$NxtSE_path)) {
                return(ui_infobox_expr(0,
                    paste("Selected path:", settings_expr$NxtSE_path), "", limited))
            } else {
                return(ui_infobox_expr(0, "Select path for NxtSE output", "", limited))
            }
        })
        output$se_expr_infobox <- renderUI({
            infoboxSE_decision()
        })
        
        
        ######################## LOADING EXPERIMENT ############################
        
        # Running makeSE (Only available on limited == TRUE)
        observeEvent(input$build_expr, {
            req(settings_expr$NxtSE_path)
            colData_path <- file.path(settings_expr$NxtSE_path, "colData.Rds")
            if(file.exists(colData_path)) {
                colData <- as.data.table(settings_expr$df.anno)
                withProgress(message = 'Loading NxtSE object', value = 0, {
                    tryCatch({
                        settings_expr$se <- makeSE(
                            settings_expr$NxtSE_path, colData,
                            realize = TRUE
                        )
                        .makeSE_sweetalert_finish(session)
                    }, error = function(e) {
                        .makeSE_sweetalert_error(session)
                    })
                })
            }
        })

        observeEvent(input$saveNxtSE_RDS, {    
            req(settings_expr$se)
            if(!is(settings_expr$se, "NxtSE")) {
                .save_NxtSE_sweetalert_error(session)
            } else {
                # First ensure colData is identical to that of NxtSE:
                colData <- as.data.frame(colData(settings_expr$se),
                    stringsAsFactors = FALSE)
                rownames(colData) <- seq_len(nrow(colData))
                colData_samples <- 
                    data.frame(sample = colnames(settings_expr$se),
                    stringsAsFactors = FALSE)
                colData <- cbind(colData_samples, colData)
                settings_expr$df.anno <- colData
                selectedfile <- parseSavePath(volumes(), 
                    input$saveNxtSE_RDS)
                req(selectedfile$datapath)
                NxtSE_list <- list(
                    se = settings_expr$se,
                    df.anno = colData,
                    df.files = settings_expr$df.files,
                    NxtSE_path = settings_expr$NxtSE_path
                )
                withProgress(message = 'Saving NxtSE as RDS', value = 0, {
                    saveRDS(NxtSE_list, selectedfile$datapath)
                })                
                .save_NxtSE_sweetalert_finish(session, 
                    selectedfile$datapath)
                settings_expr$df.files_savestate <- settings_expr$df.files
                settings_expr$df.anno_savestate <- settings_expr$df.anno

            }
        })
        
        observeEvent(input$loadNxtSE_RDS, {
            req(input$loadNxtSE_RDS)
            file_selected <- parseFilePaths(volumes(), input$loadNxtSE_RDS)
            req(file_selected$datapath)
            RDSfile <- as.character(file_selected$datapath)
            
            collection <- c("se", "df.anno", "df.files")
            withProgress(message = 'Loading NxtSE from RDS', value = 0, {
                NxtSE_list <- readRDS(RDSfile)
            })
            if(
                    !is(NxtSE_list, "list") || 
                    !all(collection %in% names(NxtSE_list)) ||
                    !is(NxtSE_list$se, "NxtSE")
            ) {
                .load_NxtSE_sweetalert_error(session)
            } else {
                .load_NxtSE_sweetalert_finish(session)
                settings_expr$disallow_df_update <- TRUE
                settings_expr$se <- NxtSE_list$se
                settings_expr$df.anno <- NxtSE_list$df.anno
                settings_expr$df.files <- NxtSE_list$df.files
                settings_expr$NxtSE_path <- NxtSE_list$NxtSE_path
                settings_expr$df.files_savestate <- settings_expr$df.files
                settings_expr$df.anno_savestate <- settings_expr$df.anno
            }
            rm(NxtSE_list)
        })
        
    # End of Server function
        return(settings_expr)
    })
}

## Internal functions

### Unifying df.files with df.anno ###

# Filter df2 by the samples in df1 by simple dataframe union
.server_expr_simple_unify_df <- function(df1, df2) {
    if(any(duplicated(df1$sample))) {
        .log("Duplicate names in current data frame", "message")
        return(df2)
    } else if(!is_valid(df2)) {
        return(data.frame(sample = df1$sample, stringsAsFactors = FALSE))
    } else {
        DT1 <- as.data.table(df1)
        DT2 <- as.data.table(df2)
        samples <- DT1[, "sample"]
        return(as.data.frame(DT2[samples, on = "sample"],
            stringsAsFactors = FALSE))
    }
}

# Populate df2 with new sample names before unifying
.server_expr_simple_unify_new_df <- function(df1, df2) {
    samples <- df1$sample
    new_samples <- setdiff(df1$sample, df2$sample)
    if(length(new_samples) > 0) {
        for(i in seq_len(length(new_samples))) {
            df2 <- rbind(df2, NA)
        }
        df2$sample[
            seq(nrow(df1) - length(new_samples) + 1, nrow(df1))
        ] <- new_samples
    }
    .server_expr_simple_unify_df(df1, df2)
}

# Filter df2 by the samples in df1
.server_expr_sync_df <- function(df1, df2) {
    if(!is_valid(df2)) {
        return(data.frame(sample = df1$sample, stringsAsFactors = FALSE))
    } else {
        # Conditions to account for:
        if(nrow(df1) > nrow(df2)) {
        # Add single empty row
            if(sum(!is_valid(df1$sample)) == 1) {
                # adding empty rows:
                .server_expr_simple_unify_df(df1, df2)
            } else {
                # might be a new data.frame or expansion of existing dataframe
                .server_expr_simple_unify_new_df(df1, df2)
            }
        } else if(nrow(df1) < nrow(df2)) {
        # Remove rows
            .server_expr_simple_unify_df(df1, df2)
        } else {
        # Same rows, editing only sample name
            n_mismatch <- sum(df1$sample != df2$sample)
            if(n_mismatch == 0) {
                return(df2)
            } else {
                n_common <- sum(df1$sample %in% df2$sample)
                if(n_common + n_mismatch == nrow(df1)) {
                    # Changing multiple names
                    df2$sample <- df1$sample
                    return(df2)
                } else {
                    # new data.frame or expansion of existing dataframe
                    .server_expr_simple_unify_new_df(df1, df2)
                }
            }
        }        
    }
}

### Generate rhandsontable from data.frame (locking specified columns)

# Generate rHOT from df (used for df.files and df.anno)
.server_expr_gen_HOT <- function(
        df, enable_select = FALSE,
        lockedColumns = "sample"
) {
    if(is_valid(df) && is(df, "data.frame")) {
        r <- rhandsontable(df, useTypes = TRUE, stretchH = "all",
            selectCallback = enable_select)
        for(columnName in lockedColumns) {
            if(columnName %in% colnames(df)) {
                r <- r %>% hot_col(columnName, readOnly = TRUE)
            }
        }
        return(r)
    } else {
        return(NULL)
    }
}

# Add BAM files from folder to list

.addBAMfiles <- function(df.bams, bam_path) {
    if(!is_valid(bam_path)) return(df.bams)
    bams <- findSamples(bam_path, suffix = ".bam", level = 1)
    if(nrow(bams) == 0) return(df.bams)
    if(any(duplicated(bams$sample))) {
        bams <- findSamples(bam_path, suffix = ".bam", level = 0)
        if(any(duplicated(bams$sample))) return(df.bams)
    }
    new_DT <- data.table(
        path = bams$path,
        sampleName = bams$sample,
        selected = TRUE
    )
    
    if(!is_valid(df.bams)) return(as.data.frame(new_DT))
    df.bams <- df.bams[!(df.bams$path %in% bams$path),]
    return(rbind(
        df.bams,
        as.data.frame(new_DT)
    ))
}

# Load SpliceWiz output files from given directory
Expr_Load_SW <- function(df.files, sw_path) {
    if(!is_valid(sw_path)) return(df.files)
    # merge splicewiz paths
    temp.DT <- findSamples(sw_path, suffix = ".txt.gz", level = 0)
    if(!is.null(temp.DT) && nrow(temp.DT) > 0) {
        temp.DT <- as.data.table(temp.DT)
        if(length(unique(temp.DT$sample)) == nrow(temp.DT)) {
            # Assume output names designate sample names
        } else {
            temp.DT <- as.data.table(findSamples(
                sw_path, suffix = ".txt.gz", level = 1))
            if(length(unique(temp.DT$sample)) == nrow(temp.DT)) {
            # Else assume subdirectory names designate sample names
            } else {
                temp.DT <- NULL
            }
        }
    } else {
        temp.DT <- NULL
    }
    if(!is.null(temp.DT) && nrow(temp.DT) > 0) {
        colnames(temp.DT)[2] <- "sw_file"
        if(is_valid(df.files)) {
            df.files <- update_data_frame(df.files, temp.DT)
        } else {
            DT <- data.table(sample = temp.DT$sample,
                sw_file = "", cov_file = "")
            DT[temp.DT, on = "sample", c("sw_file") := get("i.sw_file")] 
            df.files <- as.data.frame(DT)      
        }   
    }
    temp.DT2 <- findSamples(sw_path, suffix = ".cov", level = 0)
    if(!is.null(temp.DT2) && nrow(temp.DT2) > 0) {
        temp.DT2 <- as.data.table(temp.DT2)
        if(length(unique(temp.DT2$sample)) == nrow(temp.DT2)) {
            # Assume output names designate sample names
        } else {
            temp.DT2 <- as.data.table(findSamples(
                sw_path, suffix = ".cov", level = 1))
            if(length(unique(temp.DT2$sample)) == nrow(temp.DT2)) {
        # Else assume subdirectory names designate sample names
            } else {
                temp.DT2 <- NULL
            }
        }
    } else {
        temp.DT2 <- NULL
    }
# compile experiment df with splicewiz paths
    if(!is.null(temp.DT2) && nrow(temp.DT2) > 0) {
        colnames(temp.DT2)[2] <- "cov_file"
        df.files <- update_data_frame(df.files, temp.DT2)
    }
    return(df.files)
}

### Running processBAM after a prompt

# Brings a prompt message asking do you really want to run processBAM
Expr_PB_initiate_run <- function(input, session, n_threads, settings_expr) {
    if(
            !is_valid(settings_expr$df.bams) || 
            !("path" %in% colnames(settings_expr$df.bams))
    ) {
        sendSweetAlert(session = session, type = "error",
            title = "No bam files found",
            text = "Please load 1 or more bam files")
        return()
    }
    if(!any(settings_expr$df.bams$selected)) {
        sendSweetAlert(session = session, type = "error",
            title = "No BAM files selected", 
            text = "Please tick 1 or more BAM files in the `selected` column")
        return()        
    }
    selected_bams <- settings_expr$df.bams[settings_expr$df.bams$selected,]

    if(!is_valid(settings_expr$ref_path)) {
        sendSweetAlert(session = session,
            title = "Missing Reference", type = "error",
            text = "Please load Reference before running processBAM")
    } else if(!all(file.exists(selected_bams$path))) {
        sendSweetAlert(session = session,
            title = "Missing BAMs", type = "error",
            text = "Please check all selected bam files exist")
    } else if(any(duplicated(selected_bams$sampleName))) {
        sendSweetAlert(session = session,
            title = "Duplicate sample names detected", type = "error",
            text = "Please check all sample names are unique")
    } else if(any(selected_bams$sampleName == "")) {
        sendSweetAlert(session = session,
            title = "Empty sample names found", type = "error",
            text = "Please give a sample name to all BAM files")
    } else if(!file.exists(file.path(
            settings_expr$ref_path, "SpliceWiz.ref.gz"))) {
        sendSweetAlert(session = session, type = "error",
            title = "Missing SpliceWiz Reference",
            text = "SpliceWiz.ref.gz is missing")
    } else if(
            !is_valid(settings_expr$NxtSE_path) || 
            !dir.exists(file.path(settings_expr$NxtSE_path, "pbOutput"))
    ) {
        sendSweetAlert(session = session, type = "error",
            title = "Missing SpliceWiz (processBAM) output path",
            text = "Please set SpliceWiz (processBAM) output path")
    } else {
        msg <- paste(
            "Run processBAM on", nrow(selected_bams), "samples",
            "using", n_threads, "threads"
        )
        ask_confirmation(inputId = "pb_confirm", type = "warning", 
            title = msg, btn_labels = c("Cancel", "Run processBAM"),
            btn_colors = c("#00BFFF", "#FE2E2E"))
        return(selected_bams)
    }
    return()
}

# After user confirms, actually call processBAM
Expr_PB_actually_run <- function(input, session, n_threads, settings_expr) {
    n_bams <- nrow(settings_expr$selected_bams)
    withProgress(message = 'Running SpliceWiz (processBAM)', value = 0, {
        i_done <- 0
        incProgress(0.001, 
            message = paste('Running SpliceWiz (processBAM)',
                i_done, "of", n_bams, "done")
        )
        for(i in seq_len(n_bams)) {
            processBAM(
                bamfiles = settings_expr$selected_bams$path[i],
                sample_names = settings_expr$selected_bams$sampleName[i],
                reference_path = settings_expr$ref_path,
                output_path = file.path(settings_expr$NxtSE_path, "pbOutput"),
                n_threads = n_threads,
                run_featureCounts = FALSE,
                verbose = TRUE                    
            )
            i_done <- i_done + 1
            incProgress(1 / n_bams, 
                message = paste(i_done, "of", n_bams, "done")
            )
        }
    })

    sendSweetAlert(
        session = session,
        title = "SpliceWiz (processBAM) run completed",
        type = "success"
    )
}

# Brings a prompt message asking do you really want to run collateData
Expr_cD_initiate_run <- function(input, session, n_threads, args) {
    if(!is_valid(args[["reference_path"]])) {
        sendSweetAlert(
            session = session,
            title = "Missing Reference",
            text = "Please load Reference before running collateData",
            type = "error"
        )
        return(NULL)
    } else if(!is_valid(args[["output_path"]])) {
        sendSweetAlert(
            session = session,
            title = "Missing NxtSE Path",
            text = paste("Please select NxtSE path before",
                "running collateData"),
            type = "error"
        )
        return(NULL)
    } else if(!dir.exists(args[["output_path"]])) {
        sendSweetAlert(
            session = session,
            title = "Invalid NxtSE Path",
            text = "Please make sure NxtSE output path exists",
            type = "error"
        )
        return(NULL)
    } else if(nrow(args[["Experiment"]]) == 0) {
        sendSweetAlert(
            session = session,
            title = "No samples found to collate Experiment",
            text = "Please load processBAM output of some samples",
            type = "error"
        )
        return(NULL)
    } else {
        msg <- paste(
            "Run collateData on", nrow(args[["Experiment"]]), "samples",
            "using", n_threads, "threads"
        )
        ask_confirmation(inputId = "cD_confirm", type = "warning", 
            title = msg, btn_labels = c("Cancel", "Run collateData"),
            btn_colors = c("#00BFFF", "#FE2E2E"))
        return(args)
    }
    return(NULL)
}

# Actually run collateData
Expr_cD_actually_run <- function(input, session, n_threads, settings_expr) {
    withProgress(
            message = 'Collating SpliceWiz (processBAM) output', 
            value = 0, 
    {
        do.call(collateData, settings_expr$collateData_args)
    })
    Expr_Update_colData(
        settings_expr, 
        session, post_collateData = TRUE
    )   # saves / updates expr
}

# Load annotation file and merge with current annotations
Expr_Load_Anno <- function(df.anno, df.files, anno_file, session) {
    temp.DT <- tryCatch(fread(anno_file), error = function(e) NULL)
    if(!is_valid(temp.DT) || nrow(temp.DT) == 0) {
        sendSweetAlert(
            session = session,
            title = "Error in Annotation file",
            text = "Annotation file must be in tabular format",
            type = "error"
        )
        return(df.anno)
    }
    if(!("sample" %in% colnames(temp.DT))) {
        sendSweetAlert(
            session = session,
            title = "Error in Annotation file",
            text = "'sample' must be the name of the first column",
            type = "error"
        )
        return(df.anno)
    }
    
    files_header <- c("sw_file", "cov_file")
    anno_header <- names(temp.DT)[!(names(temp.DT) %in% files_header)]
    temp.DT.files <- copy(temp.DT)
    if(length(anno_header) > 0) temp.DT.files[, c(anno_header) := NULL]
    if(is_valid(df.files)) {
        df.files <- update_data_frame(df.files, temp.DT.files)
    } else {
        DT <- data.table(
            sample = temp.DT$sample,
            sw_file = "", cov_file = ""
        )
        df.files <- update_data_frame(DT, temp.DT.files)
    }
    temp.DT.anno <- copy(temp.DT)
    files_header_exist <- intersect(files_header, names(temp.DT))
    if(length(files_header_exist) > 0) {
        temp.DT.anno[, c(files_header_exist):= NULL]
    }
    if(is_valid(df.anno)) {
        df.anno <- update_data_frame(df.anno, temp.DT.anno)
    } else {
        df.anno <- temp.DT.files
    }
    return(df.anno)
}

# Check if savestate df is identical to loaded df
.server_expr_check_savestate <- function(settings_expr) {
    return(
        identical(settings_expr$df.anno_savestate, settings_expr$df.anno) &&
        identical(settings_expr$df.files_savestate, settings_expr$df.files)
    )
}

.server_expr_parse_collate_path <- function(limited, settings_expr, output) {
    if(limited) {
        return(.server_expr_parse_collate_path_limited(settings_expr, output))
    } else {
        return(.server_expr_parse_collate_path_full(settings_expr, output))
    }
}

# Checks collate path and report status
.server_expr_parse_collate_path_limited <- function(settings_expr, output) {
    if(is_valid(settings_expr$se)) {
        if(
                ncol(settings_expr$df.anno) > 1 &&
                .server_expr_check_savestate(settings_expr)
        ) {
            output$se_expr_infobox <- renderUI(
                ui_infobox_expr(3, "NxtSE Loaded"))
        } else if(ncol(settings_expr$df.anno) > 1) {
            output$se_expr_infobox <- renderUI(
                ui_infobox_expr(2, "NxtSE Loaded",
                    "Don't forget to save your experiment"))
        } else {
            output$se_expr_infobox <- renderUI(
                ui_infobox_expr(1, "NxtSE Loaded",
                    "Consider adding one or more conditions to Annotations"))
        }
    } else if(
            is_valid(settings_expr$collate_path) &&
            file.exists(file.path(
                settings_expr$collate_path, "seed.Rds"))
    ) {
        if(
                ncol(settings_expr$df.anno) > 1 && 
                .server_expr_check_savestate(settings_expr)
        ) {
            output$se_expr_infobox <- renderUI(
                ui_infobox_expr(2, "NxtSE ready to load",
                    "Click `Load NxtSE object`"))
        } else if(ncol(settings_expr$df.anno) > 1) {
            output$se_expr_infobox <- renderUI(
                ui_infobox_expr(1, "NxtSE ready to load",
                    # "Click `Load NxtSE object`",
                    "Don't forget to save your experiment"))
        } else {
            output$se_expr_infobox <- renderUI(
                ui_infobox_expr(1, "NxtSE ready to load",
                    "Consider adding conditions to Annotations"))
        }
    } else if(
            is_valid(settings_expr$collate_path) &&
            is_valid(settings_expr$df.files) &&
            all(file.exists(settings_expr$df.files$sw_file))
    ) {
        output$se_expr_infobox <- renderUI(
            ui_infobox_expr(1, "NxtSE not collated",
                "Run collateData via Experiment tab"))
    } else if(is_valid(settings_expr$collate_path)) {
        output$se_expr_infobox <- renderUI(
            ui_infobox_expr(0,
            submsg = "Run processBAM and collateData via the Experiment tab"))
    } else {
        output$se_expr_infobox <- renderUI(
            ui_infobox_expr(0,
            submsg = "Select output directory of collated data"))
    }
    return(output)
}

# Checks collate path and report status
.server_expr_parse_collate_path_full <- function(settings_expr, output) {
    if(
            is_valid(settings_expr$collate_path) &&
            file.exists(file.path(settings_expr$collate_path, "seed.Rds"))
    ) {
        if(.server_expr_check_savestate(settings_expr)) {
            output$se_expr_infobox <- renderUI(
                ui_infobox_expr(3, "NxtSE ready to load", 
                    "Load via Analysis -> Load Experiment"))
        } else {
            output$se_expr_infobox <- renderUI(
                ui_infobox_expr(2, "NxtSE ready to load", 
                    "Don't forget to save your experiment"))
        }
    } else if(
            is_valid(settings_expr$collate_path) &&
            is_valid(settings_expr$df.files) &&
            all(file.exists(settings_expr$df.files$sw_file))
    ) {
        output$se_expr_infobox <- renderUI(
            ui_infobox_expr(2, "Ready to collate experiment"))
    } else if(
            is_valid(settings_expr$collate_path) && 
            is_valid(settings_expr$df.files)
    ) {
        output$se_expr_infobox <- renderUI(
            ui_infobox_expr(1, "processBAM output files incomplete"))
    } else if(is_valid(settings_expr$collate_path)) {
        output$se_expr_infobox <- renderUI(ui_infobox_expr(0,
            paste("Selected path:", settings_expr$collate_path)))
    } else {
        output$se_expr_infobox <- renderUI(ui_infobox_expr(0,
            "Select path for NxtSE output"))
    }
    return(output)
}

# Save annotations to colData.Rds
.server_expr_save_expr <- function(settings_expr, colData_file, session) {
    if(
        is_valid(colData_file) && is_valid(settings_expr$df.anno) &&
            is_valid(settings_expr$df.files)
    ) {
        colData.Rds <- list(
            df.anno = settings_expr$df.anno,
            df.files = settings_expr$df.files,
            bam_path = settings_expr$bam_path,
            sw_path = settings_expr$sw_path
        )
        saveRDS(colData.Rds, colData_file)
        sendSweetAlert(
            session = session,
            title = paste("Annotations saved to", colData_file),
            type = "success"
        )
    } else {
        sendSweetAlert(
            session = session,
            title = "Annotations not saved; run collateData first!",
            type = "error"
        )
    }
}

# Check paths are legit before running collateData()
Expr_collateData_Validate_Vars <- function(
        session, Experiment, reference_path, output_path
) {
    if(!is_valid(reference_path)) {
        sendSweetAlert(
            session = session,
            title = "Missing Reference",
            text = "Please load Reference before running collateData",
            type = "error"
        )
        return(FALSE)
    } else if(!is_valid(output_path)) {
        sendSweetAlert(
            session = session,
            title = "Missing NxtSE Path",
            text = paste("Please select NxtSE path before",
                "running collateData"),
            type = "error"
        )
        return(FALSE)
    } else if(!dir.exists(output_path)) {
        sendSweetAlert(
            session = session,
            title = "Invalid NxtSE Path",
            text = "Please make sure NxtSE output path exists",
            type = "error"
        )
        return(FALSE)
    } else if(nrow(Experiment) == 0) {
        sendSweetAlert(
            session = session,
            title = "No samples found to collate Experiment",
            text = "Please load processBAM output of some samples",
            type = "error"
        )
        return(FALSE)
    }
    return(TRUE)
}

# Sends sweetAlerts to show whether collateData() has run successfully
Expr_Update_colData <- function(
        settings_expr, session, 
        post_collateData = FALSE)
{
    colData_path <- file.path(settings_expr$NxtSE_path, "colData.Rds")
    if(file.exists(colData_path)) {
        colData.Rds <- readRDS(colData_path)
        if(all(colData.Rds$df.anno$sample %in% settings_expr$df.anno$sample)) {
            colData.Rds$df.anno <- settings_expr$df.anno
            colData.Rds$df.files <- settings_expr$df.files
            saveRDS(colData.Rds, colData_path)
            if(post_collateData) {
                sendSweetAlert(
                    session = session,
                    title = "collateData run completed",
                    type = "success"
                )
            }
        } else {
            if(post_collateData) {
                sendSweetAlert(
                    session = session,
                    title = "collateData did not collate all samples",
                    type = "warning"
                )
            }
        }
    } else {
        sendSweetAlert(
            session = session,
            title = "collateData appears to have failed",
            type = "error"
        )  
    }
}

.infobox_update_se <- function(se, path) {
    ui_infobox_expr(ifelse(
        is(se, "NxtSE"), 2, ifelse(
            is_valid(path) && file.exists(file.path(path,"colData.Rds")),
            1,0)))
}

.server_expr_load_alert_success <- function(session, collate_path) {
    sendSweetAlert(
        session = session,
        title = paste("Experiment Loaded successfully from", 
            collate_path),
        type = "success"
    )
}

.server_expr_load_alert_fail <- function(session, collate_path) {
    sendSweetAlert(
        session = session,
        title = paste("No valid experiment found at", 
            collate_path),
        type = "error"
    )
}

.server_expr_ref_load_success <- function(session, ref_path) {
    sendSweetAlert(
        session = session,
        title = paste("Reference loaded successfully from", 
            ref_path),
        type = "success"
    )
}

.server_expr_ref_load_fail <- function(session, ref_path) {
    sendSweetAlert(
        session = session,
        title = paste("Reference loading failed from", 
            ref_path),
        type = "error"
    )
}

.makeSE_sweetalert_finish <- function(session) {
    sendSweetAlert(
        session = session,
        title = "NxtSE object loaded successfully",
        type = "success"
    )
}

.makeSE_sweetalert_error <- function(session) {
    sendSweetAlert(
        session = session,
        title = "Error encountered loading NxtSE object",
        type = "error"
    )
}

.load_NxtSE_sweetalert_finish <- function(session) {
    sendSweetAlert(
        session = session,
        title = "Successfully loaded NxtSE from RDS",
        type = "success"
    )
}

.load_NxtSE_sweetalert_error <- function(session) {
    sendSweetAlert(
        session = session,
        title = "Error encountered loading NxtSE from RDS",
        type = "error"
    )
}

.save_NxtSE_sweetalert_finish <- function(session, filename) {
    sendSweetAlert(
        session = session,
        title = paste("Successfully saved NxtSE to RDS", filename),
        type = "success"
    )
}

.save_NxtSE_sweetalert_error <- function(session) {
    sendSweetAlert(
        session = session,
        title = "NxtSE must first be loaded into session from folder",
        type = "error"
    )
}

.save_NxtSE_sweetalert_nonidentical <- function(session) {
    sendSweetAlert(
        session = session,
        title = paste(
            "Annotations have been edited since NxtSE last loaded.",
            "Reload NxtSE to session prior to saving as RDS"
        ),
        type = "error"
    )
}