R/app_server.R

In maxsonBraunLab/CITE-Viz: "CITEViz: Classifying Cell Clusters in CITE-Seq Data using the Flow Cytometry Gating Workflow"

#' The application server-side
#'
#' @param input,output,session Internal parameters for {shiny}.
#'     DO NOT REMOVE.
#'
#' @import shiny
#' @import ggplot2
#' @import magrittr
#'
#' @importFrom dplyr filter last left_join
#' @importFrom plotly add_histogram2dcontour add_markers config event_data event_register ggplotly layout plot_ly renderPlotly
#' @importFrom rlang is_empty
#' @importFrom SeuratObject Reductions
#' @importFrom stats as.formula quantile
#' @importFrom tools file_ext
#'
#' @noRd
app_server <- function(input, output, session) {

    # set max file upload size to 3gb (default is only 5mb) since rds files can be really big
    # takes in an integer argument for max filesize in megabytes
    # to improve: set max file upload size based on user's hardware limitations?
    options(shiny.maxRequestSize = 3000 * 1024^2)

    # Your application server logic

    # ---------- Exiting/stopping app ----------
    # if user clicks "Exit" tab in navbar,
    # input$navbar_pg changes to value of Exit tab (value = "exit"),
    # and app closes
    observe({
        if (input$navbar_pg == "exit") {
            stopApp()
        }
    })


    # ---------- Filehandling ----------
    # Putting everything in an observe function will put everything in the server function into the same environment allowing for
    # a single read of the uploaded seurat object instead of a read every time myso is called in render* function.
    # This speeds up the code immensely
    # The main function of this initial observe is to allow for a single upload of a Seurat Object over all pages.
    # Filetype validation:
    # Note that only RDS files can be inputted by the user due to the UI fileInput() argument `accept = c(".rds")`.
    # This works on an actual web browser but not in the RStudio viewer.

    observe({
        input_file_df <- input$file_input
        if (is.null(input_file_df)) {
            return(NULL)
        }

        myso <- reactiveVal(NULL) # initialize Seurat/SingleCellExperiment/other RDS object here so it is accessible to everything else in server side
        valid_file_input_flag <- reactiveVal() # set this flag so if invalid files are uploaded, the rest of the app doesn't render and throw errors due to invalid file input

        # input_data_type keeps track input data structure (Seurat object, SingleCellExperiment object, etc.)
        # 1 = Seurat object
        # 2 = SingleCellExperiment object
        input_data_type <- reactiveVal()

        duplicate_reductions_flag <- reactiveVal() # if an inputted Seurat/SingleCellExperiment/etc object contains more than one reduction with the exact same name, then this flag is set to TRUE. Else this flag is set to FALSE. This prevents duplicate reduction names from causing ambiguity in correct data retrieval and app crashing.

        observeEvent(
            list(
                # list of input events that can trigger reactive flag
                input$file_input
                # include app startup? (for reading in seurat object from memory instead of file upload)
            ),
            {
                # code to execute when one of the above input events occurs

                # check if original names of uploaded input files have RDS extension or not
                file_extensions <- tolower(tools::file_ext(input_file_df$name))

                # if only 1 file is uploaded by user
                if (length(file_extensions) == 1) {
                    # if only 1 rds file is uploaded
                    if (file_extensions == "rds") {
                        reductions_vector <- NULL

                        # read in RDS file
                        rds_obj <- readRDS(input_file_df$datapath)

                        # if object read in from RDS file is a Seurat object
                        if (inherits(rds_obj, "Seurat")) {
                            input_data_type(as.integer(1))
                            if (typeof(rds_obj) == "list") {
                                # check if integrated obj exists before retrieving it from RDS that was read in
                                integrated_obj_index <- grep("integrated", names(rds_obj), ignore.case = TRUE)

                                # if integrated obj is not in list of objs and each seurat obj in the sample list is also wrapped in a list
                                if (length(integrated_obj_index) == 0) {
                                    myso(rds_obj[[1]])
                                } else {
                                    # read in integrated obj
                                    myso(rds_obj[[integrated_obj_index]])
                                }
                            } else {
                                # if integrated obj is not in list of objs, and the obj from the RDS file is just a single Seurat obj and not a list
                                myso(rds_obj)
                            }
                            reductions_vector <- SeuratObject::Reductions(myso())
                        }
                        # else if object read in from RDS file is a SingleCellExperiment object
                        else if (inherits(rds_obj, "SingleCellExperiment")) {
                            input_data_type(as.integer(2))
                            myso(rds_obj)
                            reductions_vector <- get_choices(
                                "reductions",
                                input_data_type(),
                                myso(),
                                input_file_df
                            )
                        }
                        # set valid_file_input_flag after reading in RDS so that a Seurat object is in memory before other parts of app that require a true valid_file_input_flag can run (that way a "true" flag doesn't prematurely trigger other events to happen before a valid seurat obj is read in)
                        valid_file_input_flag(TRUE)

                        # need to render almost empty string here so that if user previously uploaded an invalid file and then uploaded a valid one afterwards, then the invalid file message gets cleared away.
                        output$file_validation_status <- renderText({
                            " "
                        })

                        # check if object contains duplicate reduction names
                        # set duplicate_reductions_flag after reading in RDS so that an RDS object is in memory before other parts of app that require a duplicate_reductions_flag==FALSE can run
                        if (length(reductions_vector) == length(unique(reductions_vector))) {
                            duplicate_reductions_flag(FALSE)
                        } else {
                            duplicate_reductions_flag(TRUE)
                            output$file_validation_status <- renderText({
                                "The uploaded file contains more than one reduction of the same name. Please check your data and make sure all reductions are uniquely named."
                            })
                        }
                    }
                    # else if the 1 file uploaded is not RDS
                    else {
                        valid_file_input_flag(FALSE)
                        output$file_validation_status <- renderText({
                            "Please upload a single RDS file."
                        })
                    }
                }
                # else if multiple files are uploaded by user
                else {
                    # send error message to user saying they need to upload 1 rds file
                    valid_file_input_flag(FALSE)
                    output$file_validation_status <- renderText({
                        "Please upload a single RDS file."
                    })
                }
            }
        )


        # ---------- ***** QC ***** ----------
        # QC plots generated from Maxson-Braun lab's CITE-seq data preprocessing pipeline

        observe({

            # require valid_file_input_flag to be TRUE in order to run rest of section in observe wrapper so that app doesn't crash if invalid file(s) are inputted
            req(
                valid_file_input_flag() == TRUE,
                duplicate_reductions_flag() == FALSE
            )

            updateSelectInput(
                session = session,
                inputId = "color_qc",
                choices = get_choices(
                    "metadata",
                    input_data_type(),
                    myso(),
                    input_file_df
                ),
                selected = get_choices(
                    "metadata",
                    input_data_type(),
                    myso(),
                    input_file_df
                )[1]
            )

            # ----- QA distribution plot -----
            # reactive distribution plot
            # reactive function will rerun this expression every time distribution_plot is called, which should be only when QA or color_qa choice is changed
            distribution_plot <- reactive({
                qc_dist_plot(input, input_data_type(), myso())
            })


            # ----- QC box plot -----
            box_plot <- reactive({
                qc_box_plot(input, input_data_type(), myso())
            })

            # ----- render QA plots -----
            # render the reactive plotly QA plots
            output$distrib_plot <- renderPlotly({
                distribution_plot()
            })
            output$box_plot <- renderPlotly({
                box_plot()
            })
        }) # end of QA observe() wrapper


        # ---------- ***** Clustering ***** ----------
        observe({

            # require valid_file_input_flag to be TRUE in order to run rest of section in observe wrapper so that app doesn't crash if invalid file(s) are inputted
            req(
                valid_file_input_flag() == TRUE,
                duplicate_reductions_flag() == FALSE
            )

            # changes the selectInput "reduction" dropdown contents to include all reductions in Seurat Object
            updateSelectInput(
                session = session,
                inputId = "reduction",
                choices = get_choices(
                    "reductions",
                    input_data_type(),
                    myso(),
                    input_file_df
                ),
                selected = dplyr::last(get_choices(
                    "reductions",
                    input_data_type(),
                    myso(),
                    input_file_df
                ))
            )

            # changes selectInput "color" dropdown contents to include all metadata in Seurat Object
            updateSelectInput(
                session = session,
                inputId = "color1",
                choices = get_choices(
                    "metadata",
                    input_data_type(),
                    myso(),
                    input_file_df
                ),
                selected = get_choices(
                    "metadata",
                    input_data_type(),
                    myso(),
                    input_file_df
                )[1]
            )

            # ----- Reactive 2D reduction graph -----
            reduc_plot <- reactive({
                reduction_2d(input, input_data_type(), myso(), input_file_df)
            })

            # ----- Reactive 3D reduction graph -----
            reduc_plot_3d <- reactive({
                reduction_3d(input, input_data_type(), myso(), input_file_df)
            })

            # ----- render clustering plots -----
            output$output_2dplot_1 <- renderPlotly({
                reduc_plot()
            })
            output$output_3dplot_1 <- renderPlotly({
                reduc_plot_3d()
            })

            # ----- datatable of metadata for cells selected in plotly -----
            # `server = FALSE` helps make it so that user can copy entire datatable to clipboard, not just the rows that are currently visible on screen
            output$cluster_pg_selected <- DT::renderDT(server = FALSE, {
                # currently returns every column of metadata dataframe. May want to select specific columns in the future
                metadata_df <- get_data(
                    category = "metadata",
                    input_data_type = input_data_type(),
                    rds_object = myso(),
                    input_file_df = input_file_df,
                    assay_name = NULL,
                    reduction_name = NULL
                )

                selected_metadata_df <- metadata_df[event_data("plotly_selected", source = "A")$customdata, ]
                cluster_dt <- DT::datatable(selected_metadata_df,
                    rownames = TRUE,
                    selection = "none", # make it so no rows can be selected (bc we currently have no need to select rows)
                    extensions = c("Buttons", "Scroller", "FixedColumns"),
                    options = list(
                        deferRender = TRUE,
                        scroller = TRUE,
                        scrollY = 400,
                        scrollX = TRUE,
                        dom = "lfrtipB",
                        buttons = c("copy", "print"),
                        fixedColumns = list(leftColumns = 1)
                    )
                )
                if (is.null(cluster_dt)) "Brushed points appear here (double-click to clear)" else cluster_dt
            })
        }) # end of clustering observed wrapper


        # ------- ***** Expression (1D) ***** ----------
        observe({

            # require valid_file_input_flag to be TRUE in order to run rest of section in observe wrapper so that app doesn't crash if invalid file(s) are inputted
            req(
                valid_file_input_flag() == TRUE,
                duplicate_reductions_flag() == FALSE
            )

            # ----- update/render UI elements -----
            updateSelectInput(
                session = session,
                inputId = "reduction_expr_1d",
                choices = get_choices(
                    "reductions",
                    input_data_type(),
                    myso(),
                    input_file_df
                ),
                selected = dplyr::last(get_choices(
                    "reductions",
                    input_data_type(),
                    myso(),
                    input_file_df
                ))
            )

            output$Assay_1d <- renderUI({
                menu_choices <- get_choices(
                    "assays",
                    input_data_type(),
                    myso(),
                    input_file_df
                )
                selectInput(
                    inputId = "Assay_1d",
                    label = "Choose assay to color reduction plot by:",
                    choices = menu_choices,
                    selected = menu_choices[1]
                )
            })

            output$feature_1d <- renderUI({
                req(input$Assay_1d)
                assay_name <- input$Assay_1d
                menu_choices <- get_choices(
                    category = NULL,
                    input_data_type(),
                    myso(),
                    input_file_df,
                    assay_name
                )
                selectInput(
                    inputId = "feature_1d",
                    label = "Choose feature to view expression levels for:",
                    choices = menu_choices,
                    selected = menu_choices[1]
                )
            })

            # ----- 1D gene/ADT expression reactive reduction graph -----
            expr_reduc_plot_1d <- eventReactive(
                list(
                    # list of input events that can trigger reactive
                    input$file_input,
                    input$reduction_expr_1d,
                    input$feature_1d
                ),
                {

                    req(
                        valid_file_input_flag() == TRUE,
                        duplicate_reductions_flag() == FALSE
                    )

                    expression_plot(input, input_data_type(), myso())

                }
            )


            # ----- render reactive reduction plots -----
            output$exploration_reduct_1d <- renderPlotly({
                expr_reduc_plot_1d()
            })


            # ----- datatable of expression for cells selected in plotly -----
            # `server = FALSE` helps make it so that user can copy entire datatable to clipboard, not just the rows that are currently visible on screen
            output$expression_pg_selected <- DT::renderDT(server = FALSE, {
                req(
                    input$file_input, input$Assay_1d, input$feature_1d,
                    valid_file_input_flag() == TRUE,
                    duplicate_reductions_flag() == FALSE
                )

                # selected feature to color clusters by
                color_x <- input$feature_1d

                count_data <- get_data(
                    category = "assays",
                    input_data_type = input_data_type(),
                    rds_object = myso(),
                    input_file_df = input_file_df,
                    assay_name = input$Assay_1d,
                    reduction_name = NULL,
                    assay_data_to_get = color_x
                )

                # num_cells_selected <- nrow(count_data)
                num_cells_expressing <- count_data %>%
                    dplyr::filter((!!as.name(color_x)) > 0) %>%
                    nrow()

                # get total num of cells in sample
                num_cells_total <- nrow(count_data)

                # convert count_data for selected cells into a dataframe
                selected_counts_df <- data.frame(
                    Feature = color_x,
                    Num_Cells_Expressing = num_cells_expressing,
                    # Percent_of_Selected = 100 * (num_cells_expressing_subset / num_cells_selected),
                    Percent_of_Total_Sample = 100 * num_cells_expressing / num_cells_total
                )

                selected_counts_dt <- DT::datatable(selected_counts_df,
                    rownames = TRUE,
                    selection = "none", # make it so no rows can be selected (bc we currently have no need to select rows)
                    extensions = c("Buttons", "Scroller", "FixedColumns"),
                    options = list(
                        deferRender = TRUE,
                        scroller = TRUE,
                        scrollY = 400,
                        scrollX = TRUE,
                        dom = "lfrtipB",
                        buttons = c("copy", "print"),
                        fixedColumns = list(leftColumns = 1)
                    )
                )
                if (is.null(selected_counts_dt)) "Brushed points appear here (double-click to clear)" else selected_counts_dt
            })
        }) # belongs to OBSERVE WRAPPER for expression tab


        # ------- ***** Co-Expression ***** ----------

        ### choose assay for x and y axes and then display dropdowns

        observe({

            req(
                valid_file_input_flag() == TRUE,
                duplicate_reductions_flag() == FALSE
            )

            # ----- update/render UI elements -----

            updateSelectInput(
                session = session,
                inputId = "reduction_expr_2d",
                choices = get_choices(
                    "reductions",
                    input_data_type(),
                    myso(),
                    input_file_df
                ),
                selected = dplyr::last(get_choices(
                    "reductions",
                    input_data_type(),
                    myso(),
                    input_file_df
                ))
            )

            output$Assay_x_axis <- renderUI({
                menu_choices <- get_choices(
                    "assays",
                    input_data_type(),
                    myso(),
                    input_file_df
                )
                selectInput(
                    inputId = "Assay_x_axis",
                    label = "Choose assay for x-axis colorscale:",
                    choices = menu_choices,
                    selected = menu_choices[1]
                )
            })

            output$Assay_y_axis <- renderUI({
                menu_choices <- get_choices(
                    "assays",
                    input_data_type(),
                    myso(),
                    input_file_df
                )
                selectInput(
                    inputId = "Assay_y_axis",
                    label = "Choose assay for y-axis colorscale:",
                    choices = menu_choices,
                    selected = menu_choices[1]
                )
            })

            output$x_axis_feature <- renderUI({
                req(input$Assay_x_axis)
                assay_name <- input$Assay_x_axis
                menu_choices <- get_choices(
                    category = NULL,
                    input_data_type(),
                    myso(),
                    input_file_df,
                    assay_name
                )
                selectInput(
                    inputId = "x_axis_feature",
                    label = "Choose feature for x-axis colorscale:",
                    choices = menu_choices,
                    selected = menu_choices[1]
                )
            })

            output$y_axis_feature <- renderUI({
                req(input$Assay_y_axis)
                assay_name <- input$Assay_y_axis
                menu_choices <- get_choices(
                    category = NULL,
                    input_data_type(),
                    myso(),
                    input_file_df,
                    assay_name
                )
                selectInput(
                    inputId = "y_axis_feature",
                    label = "Choose feature for y-axis colorscale:",
                    choices = menu_choices,
                    selected = menu_choices[2]
                )
            })


            # ----- 2D gene/ADT coexpression reactive reduction graph -----

            coexpr_reduc_plot <- eventReactive(
                list(
                    # list of input events that can trigger reactive plot
                    input$file_input,
                    input$reduction_expr_2d,
                    input$x_axis_feature,
                    input$y_axis_feature
                ),
                {
                    coexpression_plot(input, input_data_type(), myso())
                }
            )


            # ----- render reactive reduction plots -----
            output$color_legend_2d <- renderPlotly({
                req(
                    valid_file_input_flag() == TRUE,
                    duplicate_reductions_flag() == FALSE
                )
                create_2d_color_legend( 
                    input = input,
                    input_data_type = input_data_type(),
                    rds_object = myso(),
                    input_file_df = input_file_df
                )
            })
            output$exploration_reduct_2d <- renderPlotly({
                coexpr_reduc_plot()
            })

        }) # belongs to OBSERVE WRAPPER for co-expression tab


        # ---------- ***** Gating ***** ----------
        observe({

            # require valid_file_input_flag to be TRUE in order to run rest of section in observe wrapper so that app doesn't crash if invalid file(s) are inputted
            req(
                valid_file_input_flag() == TRUE,
                duplicate_reductions_flag() == FALSE
            )

            # ----- update/render UI elements -----
            output$Assay <- renderUI({
                menu_choices <- get_choices(
                    "assays",
                    input_data_type(),
                    myso(),
                    input_file_df
                )
                selectInput(
                    inputId = "Assay",
                    label = "Choose assay:",
                    choices = menu_choices,
                    selected = menu_choices[1]
                )
            })

            output$x_feature <- renderUI({
                req(input$Assay)
                assay_name <- input$Assay
                menu_choices <- get_choices(
                    category = NULL,
                    input_data_type(),
                    myso(),
                    input_file_df,
                    assay_name
                )
                selectInput(
                    inputId = "x_feature",
                    label = "Choose x-axis feature:",
                    choices = menu_choices,
                    selected = menu_choices[1]
                )
            })

            output$y_feature <- renderUI({
                req(input$Assay)
                assay_name <- input$Assay
                menu_choices <- get_choices(
                    category = NULL,
                    input_data_type(),
                    myso(),
                    input_file_df,
                    assay_name
                )
                selectInput(
                    inputId = "y_feature",
                    label = "Choose y-axis feature:",
                    choices = menu_choices,
                    selected = menu_choices[2]
                )
            })

            # changes the selectInput "reduction" dropdown contents to include all reductions in Seurat Object
            updateSelectInput(
                session = session,
                inputId = "gating_reduction",
                choices = get_choices(
                    "reductions",
                    input_data_type(),
                    myso(),
                    input_file_df
                ),
                selected = dplyr::last(get_choices(
                    "reductions",
                    input_data_type(),
                    myso(),
                    input_file_df
                ))
            )
            updateSelectInput(
                session = session,
                inputId = "gating_color_dimred",
                choices = get_choices(
                    "metadata",
                    input_data_type(),
                    myso(),
                    input_file_df
                ),
                selected = get_choices(
                    "metadata",
                    input_data_type(),
                    myso(),
                    input_file_df
                )[1]
            )

            # ----- Last-clicked buttons tracker -----
            # keep track of last 2 buttons clicked (either gate button, reset button, or clear-all-gates button) in gating tab bc this will determine which data to use for reactive ADT scatterplot
            # second-to-last clicked button will determine what data will be used for input gating cells and input cell count
            # default is "NA" (using NULL causes problems when rendering reactive featurescatter)
            # but if reset, gate, or clear-all-gates button is clicked, then the values of last_buttons_clicked will reflect that click

            last_buttons_clicked <- reactiveValues(last = "NA", second_to_last = "NA")

            observeEvent(input$reset_adt_scatter, {
                req(input$x_feature, input$y_feature) # needed so that nothing happens if button is pressed before initial scatterplot renders upon startup
                last_buttons_clicked$second_to_last <- last_buttons_clicked$last
                last_buttons_clicked$last <- "reset_button"
            })
            observeEvent(input$gate, {
                req(input$x_feature, input$y_feature) # needed so that nothing happens if button is pressed before initial scatterplot renders upon startup
                last_buttons_clicked$second_to_last <- last_buttons_clicked$last
                last_buttons_clicked$last <- "gate_button"
            })


            # ----- reactive scatterplot of assay features -----
            reactive_featurescatter <- eventReactive(
                list(
                    # list of input events that can
                    # trigger reactive featurescatter
                    input$file_input,
                    input$gate,
                    input$reset_adt_scatter,
                    input$clear_all_gates,
                    input$x_feature,
                    input$y_feature,
                    input$gating_pg_table_rows_selected
                ),
                {

                    req(
                        valid_file_input_flag() == TRUE,
                        duplicate_reductions_flag() == FALSE
                    )

                    gate_scatterplot(
                        input,
                        input_data_type(),
                        myso(),
                        last_buttons_clicked,
                        gate_list(),
                        selected_gate()
                    )

                }
            )

            # ----- reactive gating 2D reduction graph -----
            gating_reduc_plot <- reactive({

                req(
                    valid_file_input_flag() == TRUE,
                    duplicate_reductions_flag() == FALSE
                )

                gate_reduction(
                    input,
                    input_data_type(),
                    myso(),
                    last_buttons_clicked,
                    gate_list(),
                    selected_gate()
                )

            })


            # ----- render gating plots -----
            # render reactive feature scatterplot
            output$featurescatter_2d <- renderPlotly({
                reactive_featurescatter()
            })

            # render reactive UMAP
            output$gating_reduc_2d <- renderPlotly({
                gating_reduc_plot()
            })


            # ----- generate Gate objects -----
            gate_reactive_values <- reactiveValues()
            gate_list <- get_reactive_gate_list(gate_reactive_values)
            counter_reactive <- reactiveVal(as.integer(0))

            # holds value of gate that is selected from gating datatable in case user wants to go back and re-gate from selected gate
            selected_gate <- reactiveVal(NULL)

            # events triggered by clicking gate button
            observeEvent(input$gate, {
                req(input$x_feature, input$y_feature)

                count_data <- get_data(
                    category = "assays",
                    input_data_type = input_data_type(),
                    rds_object = myso(),
                    input_file_df = input_file_df,
                    assay_name = input$Assay,
                    reduction_name = NULL,
                    assay_data_to_get = c(input$x_feature, input$y_feature)
                )

                # get plotly event data
                sel <- event_data("plotly_selected", source = "C")
                brushed_coords <- event_data("plotly_brushed", source = "C")

                # increment counter every time gate button is clicked
                counter <- as.integer(counter_reactive() + 1)
                counter_reactive(counter)

                # create gate object based on UI input
                gate_reactive_values[[paste0("gate_", counter)]] <- create_gate_from_input(
                    input = input,
                    is_forward_gating = TRUE,
                    assay_count_data = count_data,
                    gate_counter = counter,
                    reactive_gate_list = gate_list(),
                    reactive_selected_gate = selected_gate(),
                    reactive_last_buttons_clicked = last_buttons_clicked
                )
            }) # end of gating logic for events triggered by clicking gate button


            # ----- generate reactive gating dataframe -----
            reactive_gating_df <- reactive({

                # gating dataframe (full version) for download
                full_gating_df <- create_gating_df()

                if (!rlang::is_empty(names(gate_list()))) {
                    full_gating_list <- lapply(names(gate_list()), update_gating_df, reactive_gate_list = gate_list(), temp_gating_df = full_gating_df)
                    full_gating_df <- do.call(rbind, full_gating_list)
                }
                full_gating_df
            })

            # returns data table of summary data for each gate object
            output$gating_pg_table <- DT::renderDT({
                # data table is generated here
                gating_dt <- create_gating_dt(reactive_gating_df())
                if (is.null(gating_dt)) "Brushed points appear here (double-click to clear)" else gating_dt
            })


            # ----- datatable event handlers -----

            # Update back-end gating data when user edits name of cell subset in front-end datatable
            observeEvent(input$gating_pg_table_cell_edit, {
                cell_edit_data <- input$gating_pg_table_cell_edit
                gate_id <- reactive_gating_df()$Gate_ID[cell_edit_data$row]
                gate_reactive_values[[gate_id]] <- SetSubsetName(gate_reactive_values[[gate_id]], cell_edit_data$value)
            })

            # when a datatable row is selected, set the selected_gate reactive value to the gate that was selected in the datatable
            # this ensures that if the user wants to re-gate based on this gate, then the corresponding input gate stats are correct
            observeEvent(input$gating_pg_table_rows_selected, {
                row_index <- input$gating_pg_table_rows_selected
                selected_gate(reactive_gating_df()$Gate_ID[row_index])

                # update assay, x and y axis dropdowns to reflect the same axes shown in selected gate, so that if user gates from this selected gate, the right axes are recorded for the new gate
                updateSelectInput(
                    session = session,
                    inputId = "Assay",
                    selected = get_gate_data(gate_list()[[selected_gate()]], "assay_name")
                )
                updateSelectInput(
                    session = session,
                    inputId = "x_feature",
                    selected = get_gate_data(gate_list()[[selected_gate()]], "x_axis")
                )
                updateSelectInput(
                    session = session,
                    inputId = "y_feature",
                    selected = get_gate_data(gate_list()[[selected_gate()]], "y_axis")
                )
            })

            # when clear all gates button is clicked or new rds file is uploaded, reset gating info
            observeEvent(
                list(
                    # list of input events that can trigger resetting of gating info
                    input$clear_all_gates,
                    input$file_input
                ),
                {
                    # require valid_file_input_flag to be TRUE in order to run rest of section in observe wrapper so that app doesn't crash if invalid file(s) are inputted
                    req(
                        valid_file_input_flag() == TRUE,
                        duplicate_reductions_flag() == FALSE
                    )

                    counter_reactive(as.integer(0))

                    # reset all values in gate_reactive_values to NULL
                    if (!rlang::is_empty(names(gate_reactive_values))) {
                        gate_reactive_values <- lapply(names(gate_reactive_values), set_gates_to_null, local_gate_reactive_values = gate_reactive_values)
                    }

                    # update last-buttons tracker
                    last_buttons_clicked$second_to_last <- last_buttons_clicked$last
                    last_buttons_clicked$last <- "clear_all_gates_button"
                }
            )


            # ----- gating data download handlers -----
            output$download_as_list_rds <- downloadHandler(
                filename = "gate_info_list.rds",
                content = function(file) {
                    saveRDS(gate_list(), file = file)
                }
            )
            output$download_as_df_rds <- downloadHandler(
                filename = "gate_info_df.rds",
                content = function(file) {
                    saveRDS(reactive_gating_df(), file = file)
                }
            )
        }) # belongs to OBSERVE WRAPPER for gating tab


        # ---------- ***** BackGating ***** ----------
        observe({

            # require valid_file_input_flag to be TRUE in order to run rest of section in observe wrapper so that app doesn't crash if invalid file(s) are inputted
            req(
                valid_file_input_flag() == TRUE,
                duplicate_reductions_flag() == FALSE
            )

            # ----- update/render UI elements -----
            output$Assay_bg <- renderUI({
                menu_choices <- get_choices(
                    "assays",
                    input_data_type(),
                    myso(),
                    input_file_df
                )
                selectInput(
                    inputId = "Assay_bg",
                    label = "Choose assay:",
                    choices = menu_choices,
                    selected = menu_choices[1]
                )
            })

            output$x_feature_bg <- renderUI({
                req(input$Assay_bg)
                assay_name <- input$Assay_bg
                menu_choices <- get_choices(
                    category = NULL,
                    input_data_type(),
                    myso(),
                    input_file_df,
                    assay_name
                )
                selectInput(
                    inputId = "x_feature_bg",
                    label = "Choose x-axis feature:",
                    choices = menu_choices,
                    selected = menu_choices[1]
                )
            })

            output$y_feature_bg <- renderUI({
                req(input$Assay_bg)
                assay_name <- input$Assay_bg
                menu_choices <- get_choices(
                    category = NULL,
                    input_data_type(),
                    myso(),
                    input_file_df,
                    assay_name
                )
                selectInput(
                    inputId = "y_feature_bg",
                    label = "Choose y-axis feature:",
                    choices = menu_choices,
                    selected = menu_choices[2]
                )
            })

            # changes the selectInput "reduction" dropdown contents to include all reductions in Seurat Object
            updateSelectInput(
                session = session,
                inputId = "reduction_bg",
                choices = get_choices(
                    "reductions",
                    input_data_type(),
                    myso(),
                    input_file_df
                ),
                selected = dplyr::last(get_choices(
                    "reductions",
                    input_data_type(),
                    myso(),
                    input_file_df
                ))
            )
            updateSelectInput(
                session = session,
                inputId = "color2_bg",
                choices = get_choices(
                    "metadata",
                    input_data_type(),
                    myso(),
                    input_file_df
                ),
                selected = get_choices(
                    "metadata",
                    input_data_type(),
                    myso(),
                    input_file_df
                )[1]
            )

            # ----- Last-clicked buttons tracker -----
            # keep track of last 2 buttons clicked (either gate button, reset button, or clear-all-gates button) in gating tab bc this will determine which data to use for reactive ADT scatterplot
            # second-to-last clicked button will determine what data will be used for input gating cells and input cell count
            # default is "NA" (using NULL causes problems when rendering reactive featurescatter)
            # but if reset, gate, or clear-all-gates button is clicked, then the values of last_buttons_clicked will reflect that click

            last_buttons_clicked_bg <- reactiveValues(last = "NA", second_to_last = "NA")

            observeEvent(input$reset_adt_scatter_bg, {
                req(input$x_feature_bg, input$y_feature_bg) # needed so that nothing happens if button is pressed before initial scatterplot renders upon startup
                last_buttons_clicked_bg$second_to_last <- last_buttons_clicked_bg$last
                last_buttons_clicked_bg$last <- "reset_button"
            })
            observeEvent(input$gate_bg, {
                req(input$x_feature_bg, input$y_feature_bg) # needed so that nothing happens if button is pressed before initial scatterplot renders upon startup
                last_buttons_clicked_bg$second_to_last <- last_buttons_clicked_bg$last
                last_buttons_clicked_bg$last <- "gate_button"
            })

            # ----- backgate reactive scatterplot of assay features -----
            reactive_featurescatter_bg <- eventReactive(
                list(
                    # list of input events that can trigger reactive featurescatter
                    input$file_input,
                    input$gate_bg,
                    input$reset_adt_scatter_bg,
                    input$clear_all_gates_bg,
                    input$x_feature_bg,
                    input$y_feature_bg,
                    input$gating_pg_table_bg_rows_selected,
                    event_data("plotly_selected", source = "D")
                ),
                {
                    # code to execute when one of the above input events occurs
                    req(input$x_feature_bg, input$y_feature_bg, valid_file_input_flag)


                    gating_color_scale <- data.frame(
                        z = c(0.0, 0.20, 0.40, 0.60, 0.80, 1.0),
                        col = c("#FFFFFF", "#4564FE", "#76EFFF", "#FFF900", "#FFA300", "#FF1818")
                    )

                    count_data <- get_data(
                        category = "assays",
                        input_data_type = input_data_type(),
                        rds_object = myso(),
                        input_file_df = input_file_df,
                        assay_name = input$Assay_bg,
                        reduction_name = NULL,
                        assay_data_to_get = c(input$x_feature_bg, input$y_feature_bg)
                    )

                    selected_cell_barcodes <- NULL

                    if (is.null(input$gating_pg_table_bg_rows_selected)) {
                        selected_cell_barcodes <- event_data("plotly_selected", source = "D")$customdata
                    } else {
                        selected_cell_barcodes <- get_gate_data(gate_list_bg()[[selected_gate_bg()]], "subset_cells")[[1]]
                    }

                    plot_ly(count_data,
                        x = ~ count_data[, input$x_feature_bg], y = ~ count_data[, input$y_feature_bg],
                        customdata = rownames(count_data),
                        mode = "markers",
                        color = rownames(count_data) %in% selected_cell_barcodes, # color cells by whether they're in the selection or not
                        colors = c("grey", "black")
                    ) %>%
                        add_histogram2dcontour(
                            showscale = FALSE,
                            ncontours = 10,
                            colorscale = gating_color_scale,
                            contours = list(coloring = "heatmap"),
                            color = I("black"),
                            size = I(1.5)
                        ) %>%
                        add_markers(
                            x = count_data[, input$x_feature_bg],
                            y = count_data[, input$y_feature_bg],
                            marker = list(size = 2),
                            alpha = 1
                        ) %>%
                        config(
                            toImageButtonOptions = list(format = "png", scale = 10) # scale title/legend/axis labels by this factor so that they are high-resolution when downloaded
                        ) %>%
                        # Layout changes the aesthetic of the plot
                        layout(
                            title = "Normalized Feature Scatter Plot",
                            xaxis = list(title = input$x_feature_bg),
                            yaxis = list(title = input$y_feature_bg),
                            showlegend = FALSE
                        )
                }
            )

            # ----- backgate reactive reduction plot of selected cell features -----
            gating_reduc_plot_bg <- reactive({
                req(input$file_input, input$color2_bg, input$reduction_bg, valid_file_input_flag)

                # creates string for reduction to plot
                reduc <- input$reduction_bg

                # selected metadata to color clusters by
                color <- input$color2_bg

                metadata_df <- get_data(
                    category = "metadata",
                    input_data_type = input_data_type(),
                    rds_object = myso(),
                    input_file_df = input_file_df,
                    assay_name = NULL,
                    reduction_name = NULL
                )

                # interpolate the base color palette so that exact number of colors in custom palette is same as number of unique values for selected metadata category
                custom_palette <- get_palette(length(unique(metadata_df[[color]])))
                plotly_color_list <- c(paste0("metadata_df$", color), "custom_palette")

                # creates dataframe from reduction selected
                cell_data <- get_data(
                    category = "reductions",
                    input_data_type = input_data_type(),
                    rds_object = myso(),
                    input_file_df = input_file_df,
                    assay_name = NULL,
                    reduction_name = reduc
                )

                # creates list containing all column names of cell_data
                cell_col <- colnames(cell_data)

                plot_ly(cell_data,
                    x = ~ cell_data[, 1],
                    y = ~ cell_data[, 2],
                    customdata = rownames(cell_data),
                    color = stats::as.formula(paste0("~", plotly_color_list[1])), # color by selected metadata in object
                    colors = stats::as.formula(paste0("~", plotly_color_list[2])),
                    type = "scatter",
                    mode = "markers",
                    marker = list(size = 3, width = 2),
                    source = "D"
                ) %>%
                    config(
                        toImageButtonOptions = list(
                            format = "png",
                            scale = 10
                        )
                    ) %>%
                    layout(
                        title = toupper(reduc),
                        xaxis = list(title = cell_col[1]),
                        yaxis = list(title = cell_col[2]),
                        dragmode = "select",
                        legend = list(itemsizing = "constant")
                    ) %>%
                    event_register("plotly_selected")
            })


            # ----- render backgating plots -----
            # render reactive feature scatterplot
            output$featurescatter_2d_bg <- renderPlotly({
                reactive_featurescatter_bg()
            })

            # render reactive UMAP
            output$gating_reduc_2d_bg <- renderPlotly({
                gating_reduc_plot_bg()
            })


            # ----- generate Gate objects -----
            gate_reactive_values_bg <- reactiveValues()
            gate_list_bg <- get_reactive_gate_list(gate_reactive_values_bg)

            counter_reactive_bg <- reactiveVal(as.integer(0))

            # holds value of gate that is selected from gating datatable in case user wants to go back and re-gate from selected gate
            selected_gate_bg <- reactiveVal(NULL)

            # events triggered by clicking gate button
            observeEvent(input$gate_bg, {
                req(input$x_feature_bg, input$y_feature_bg)

                count_data <- get_data(
                    category = "assays",
                    input_data_type = input_data_type(),
                    rds_object = myso(),
                    input_file_df = input_file_df,
                    assay_name = input$Assay_bg,
                    reduction_name = NULL,
                    assay_data_to_get = c(input$x_feature_bg, input$y_feature_bg)
                )

                # get plotly event data
                sel <- event_data("plotly_selected", source = "D")
                brushed_coords <- event_data("plotly_brushed", source = "D")

                # increment counter every time gate button is clicked
                counter <- as.integer(counter_reactive_bg() + 1)
                counter_reactive_bg(counter)

                # create gate object based on UI input
                gate_reactive_values_bg[[paste0("gate_", counter)]] <- create_gate_from_input(
                    input = input,
                    is_forward_gating = FALSE,
                    assay_count_data = count_data,
                    gate_counter = counter,
                    reactive_gate_list = gate_list_bg(),
                    reactive_selected_gate = selected_gate_bg(),
                    reactive_last_buttons_clicked = last_buttons_clicked_bg
                )
            }) # end of gating logic for events triggered by clicking gate button


            # ----- generate reactive backgating dataframe -----
            reactive_gating_df_bg <- reactive({

                # gating dataframe (full version) for download
                full_gating_df <- create_gating_df()

                if (!rlang::is_empty(names(gate_list_bg()))) {
                    full_gating_list <- lapply(names(gate_list_bg()), update_gating_df, reactive_gate_list = gate_list_bg(), temp_gating_df = full_gating_df)
                    full_gating_df <- do.call(rbind, full_gating_list)
                }
                full_gating_df
            })

            # returns data table of summary data for each gate object
            output$gating_pg_table_bg <- DT::renderDT({
                # data table is generated here
                gating_dt <- create_gating_dt(reactive_gating_df_bg())
                if (is.null(gating_dt)) "Brushed points appear here (double-click to clear)" else gating_dt
            })


            # ----- datatable event handlers -----

            # Update back-end gating data when user edits name of cell subset in front-end datatable
            observeEvent(input$gating_pg_table_bg_cell_edit, {
                cell_edit_data <- input$gating_pg_table_bg_cell_edit
                gate_id <- reactive_gating_df_bg()$Gate_ID[cell_edit_data$row]
                gate_reactive_values_bg[[gate_id]] <- SetSubsetName(gate_reactive_values_bg[[gate_id]], cell_edit_data$value)
            })

            # when a datatable row is selected, set the selected_gate_bg reactive value to the gate that was selected in the datatable
            # this ensures that if the user wants to re-gate based on this gate, then the corresponding input gate stats are correct
            observeEvent(input$gating_pg_table_bg_rows_selected, {
                row_index <- input$gating_pg_table_bg_rows_selected
                selected_gate_bg(reactive_gating_df_bg()$Gate_ID[row_index])

                # update assay, x and y axis dropdowns to reflect the same axes shown in selected gate, so that if user gates from this selected gate, the right axes are recorded for the new gate
                updateSelectInput(
                    session = session,
                    inputId = "Assay_bg",
                    selected = get_gate_data(gate_list_bg()[[selected_gate_bg()]], "assay_name")
                )
                updateSelectInput(
                    session = session,
                    inputId = "x_feature_bg",
                    selected = get_gate_data(gate_list_bg()[[selected_gate_bg()]], "x_axis")
                )
                updateSelectInput(
                    session = session,
                    inputId = "y_feature_bg",
                    selected = get_gate_data(gate_list_bg()[[selected_gate_bg()]], "y_axis")
                )
            })

            # when clear all gates button is clicked or new rds file is uploaded, reset gating info
            observeEvent(
                list(
                    # list of input events that can trigger resetting of gating info
                    input$clear_all_gates_bg,
                    input$file_input
                ),
                {
                    # require valid_file_input_flag to be TRUE in order to run rest of section in observe wrapper so that app doesn't crash if invalid file(s) are inputted
                    req(
                        valid_file_input_flag() == TRUE,
                        duplicate_reductions_flag() == FALSE
                    )

                    counter_reactive_bg(as.integer(0))

                    # reset all values in gate_reactive_values to NULL
                    if (!rlang::is_empty(names(gate_reactive_values_bg))) {
                        gate_reactive_values_bg <- lapply(names(gate_reactive_values_bg), set_gates_to_null, local_gate_reactive_values = gate_reactive_values_bg)
                    }

                    # update last-buttons tracker
                    last_buttons_clicked_bg$second_to_last <- last_buttons_clicked_bg$last
                    last_buttons_clicked_bg$last <- "clear_all_gates_button"
                }
            )


            # ----- backgating data download handlers -----
            output$download_as_list_rds_bg <- downloadHandler(
                filename = "backgate_info_list.rds",
                content = function(file) {
                    saveRDS(gate_list_bg(), file = file)
                }
            )
            output$download_as_df_rds_bg <- downloadHandler(
                filename = "backgate_info_df.rds",
                content = function(file) {
                    saveRDS(reactive_gating_df_bg(), file = file)
                }
            )
        }) # belongs to OBSERVE WRAPPER for backgating tab
    }) # belongs to end of observe wrapper FOR ALL BACKEND
} # end of server/back end code