MCView: A Shiny App for Metacell Analysis

#' annotate UI Function
#'
#' @description A shiny Module.
#'
#' @param id,input,output,session Internal parameters for {shiny}.
#'
#' @noRd
#'
#' @importFrom shiny NS tagList
mod_annotate_ui <- function(id) {
    ns <- NS(id)
    tagList(
        fluidRow(
            column(
                width = 8,
                style = "padding-right:0px;",
                projection_box(ns, "gene_projection", color_choices = c("Cell type", "Gene", "Gene module", "Metadata", "Selected")),
                fluidRow(
                    uiOutput(ns("time_box_ui_column")),
                    column(
                        width = 6,
                        offset = 0,
                        style = "padding-right:0px;",
                        scatter_box(ns, "gene_gene_box", show_legend = FALSE)
                    ),
                    column(
                        width = 6,
                        offset = 0,
                        style = "padding-left:0px;",
                        diff_expr_box(ns, "mc_mc_box")
                    )
                )
            ),
            column(
                width = 4,
                style = "padding-right:0px; padding-left:0px;",
                generic_box(
                    id = ns("metacell_types_box"),
                    title = "Metacell annotation",
                    status = "primary",
                    solidHeader = TRUE,
                    collapsible = TRUE,
                    closable = FALSE,
                    width = 12,
                    sidebar = shinydashboardPlus::boxSidebar(
                        startOpen = FALSE,
                        width = 50,
                        id = ns("metacell_types_box_sidebar"),
                        checkboxInput(ns("add_to_selection"), label = "Add to\ncurrent selection", value = TRUE),
                        checkboxInput(ns("reset_on_apply"), label = "Reset selection\non apply", value = TRUE)
                    ),
                    splitLayout(
                        cellWidths = c("30%", rep("auto", 4)),
                        fileInput(ns("metacell_types_fn"),
                            label = NULL,
                            buttonLabel = "Load",
                            multiple = FALSE,
                            accept =
                                c(
                                    "text/csv",
                                    "text/comma-separated-values,text/plain",
                                    "text/tab-separated-values",
                                    ".csv",
                                    ".tsv"
                                )
                        ),
                        actionButton(ns("reset_metacell_types"), "Reset", style = "align-items: center;"),
                        actionButton(ns("paste_metacells"), "Paste", style = "align-items: center;"),
                        actionButton(ns("copy_metacells"), "Copy", style = "align-items: center;"),
                        downloadButton(ns("metacell_types_download"), "", style = "align-items: center;")
                    ),
                    uiOutput(ns("annotation_box")),
                    uiOutput(ns("update_all_selectors")),
                    shinycssloaders::withSpinner(
                        DT::dataTableOutput(ns("mc_type_table"))
                    )
                )
            ),
            column(
                width = 4,
                style = "padding-right:0px; padding-left:0px;",
                generic_box(
                    id = ns("cell_type_colors"),
                    title = "Cell Types",
                    status = "primary",
                    solidHeader = TRUE,
                    collapsible = TRUE,
                    closable = FALSE,
                    width = 12,
                    span(
                        actionButton(ns("add_cell_type_modal"), "Add"),
                        actionButton(ns("reset_cell_type_colors"), "Reset"),
                        downloadButton(ns("cell_type_colors_download"), "")
                    ),
                    br(),
                    br(),
                    uiOutput(ns("annot_color_picker")),
                    shinycssloaders::withSpinner(
                        DT::dataTableOutput(ns("cell_type_table"))
                    )
                )
            )
        )
    )
}


#' annotate sidebar UI Function
#'
#' @description A shiny Module.
#'
#' @param id,input,output,session Internal parameters for {shiny}.
#'
#' @noRd
#'
#' @importFrom shiny NS tagList
mod_annotate_sidebar_ui <- function(id) {
    ns <- NS(id)
    tagList(
        uiOutput(ns("cell_type_list")),
        tags$hr(),
        shinyWidgets::switchInput(ns("show_correlations"), "Show correlations", value = FALSE, onLabel = "Yes", offLabel = "No", onStatus = "success", offStatus = "danger", size = "mini"),
        uiOutput(ns("top_correlated_select_x_axis")),
        uiOutput(ns("top_correlated_select_y_axis")),
        uiOutput(ns("top_correlated_select_color_by")),
        uiOutput(ns("top_correlated_select_color_proj"))
    )
}


#' annotate Server Function
#'
#' @noRd
mod_annotate_server <- function(id, dataset, metacell_types, cell_type_colors, gene_modules, globals) {
    moduleServer(
        id,
        function(input, output, session) {
            ns <- session$ns
            selected_cell_types <- reactiveVal(NULL)

            # gene selectors
            values <- reactiveValues(file_status = NULL)
            top_correlated_selectors(input, output, session, dataset, metacell_types, ns, gene_modules = gene_modules, selected_cell_types = selected_cell_types)
            scatter_selectors(ns, dataset, output, globals)

            observeEvent(input$metacell_types_fn, {
                values$file_status <- "uploaded"
            })

            observe({
                req(input$metacell_types_fn)
                req(values$file_status)
                new_metacell_types <- tgutil::fread(input$metacell_types_fn$datapath, colClasses = c("cell_type" = "character", "metacell" = "character")) %>% as_tibble()

                input_ok <- TRUE
                required_fields <- c("cell_type", "metacell")
                if (!all(required_fields %in% colnames(new_metacell_types))) {
                    showNotification(glue("Please provide a file with the following fields: cell_type, metacell"), type = "error")
                    input_ok <- FALSE
                }

                metacells <- get_metacell_ids(project, dataset())

                unknown_metacells <- new_metacell_types$metacell[!(new_metacell_types$metacell %in% metacells)]
                if (length(unknown_metacells) > 0) {
                    mcs <- paste(unknown_metacells, collapse = ", ")
                    showNotification(glue("Metacell types contains metacells that are missing from the data: {mcs}"), type = "error")
                    input_ok <- FALSE
                }

                missing_metacells <- metacells[!(metacells %in% new_metacell_types$metacell)]
                if (length(missing_metacells) > 0) {
                    mcs <- paste(missing_metacells, collapse = ", ")
                    showNotification(glue("Some metacells are missing from metacell types: {mcs}"), type = "warning")
                }

                if (input_ok) {
                    if (has_name(new_metacell_types, "color")) {
                        new_cell_type_colors <- new_metacell_types %>%
                            distinct(cell_type, color) %>%
                            select(cell_type, color) %>%
                            filter(cell_type != "(Missing)") %>%
                            arrange(cell_type) %>%
                            mutate(order = 1:n())

                        cell_type_colors(new_cell_type_colors)
                    }

                    cur_metacell_types <- metacell_types()
                    new_metacell_types <- cur_metacell_types %>%
                        select(-any_of(c("cell_type"))) %>%
                        left_join(new_metacell_types %>% select(metacell, cell_type), by = "metacell") %>%
                        mutate(cell_type = ifelse(cell_type == "(Missing)", NA, cell_type)) %>%
                        mutate(cell_type = as.character(forcats::fct_na_value_to_level(factor(cell_type), "(Missing)")))

                    new_metacell_types <- sanitize_metacell_types(new_metacell_types, cell_type_colors(), dataset())
                    metacell_types(new_metacell_types)
                    values$file_status <- NULL
                }
            })

            # export metacell types file
            output$metacell_types_download <- downloadHandler(
                filename = function() {
                    paste("metacell_types-", Sys.Date(), ".csv", sep = "")
                },
                content = function(file) {
                    fwrite(
                        metacell_types() %>%
                            select(metacell, cell_type, top1_gene, top1_lfp, top2_gene, top2_lfp) %>%
                            left_join(cell_type_colors() %>% select(cell_type, color), by = "cell_type"),
                        file
                    )
                }
            )

            # export cell type colors file
            output$cell_type_colors_download <- downloadHandler(
                filename = function() {
                    paste("cell_type_colors-", Sys.Date(), ".csv", sep = "")
                },
                content = function(file) {
                    fwrite(
                        cell_type_colors() %>%
                            select(cell_type, color),
                        file
                    )
                }
            )

            # set reactive values
            selected_metacell_types <- reactiveVal(tibble(metacell = character(), cell_type = character()))
            to_show <- reactiveVal()

            # keep the last cell type that was chosen in order for it to be defaultly selected
            last_chosen_cell_type <- reactiveVal("(Missing)")

            observeEvent(input$reset_metacell_types, {
                metacell_types(get_metacell_types_data(dataset()))
                selected_metacell_types(tibble(metacell = character(), cell_type = character()))
                to_show(NULL)
                last_chosen_cell_type("(Missing)")
                values$file_status <- NULL
            })

            observeEvent(input$paste_metacells, {
                selected_metacells <- unique(globals$clipboard)

                new_selected_annot <- metacell_types() %>% filter(metacell %in% selected_metacells)
                if (!is.null(input$add_to_selection) && input$add_to_selection) {
                    selected_metacell_types(
                        bind_rows(
                            selected_metacell_types(),
                            new_selected_annot
                        ) %>% distinct(metacell, cell_type)
                    )
                } else {
                    selected_metacell_types(new_selected_annot %>% distinct(metacell, cell_type))
                }
            })

            observeEvent(input$copy_metacells, {
                selected_metacells <- selected_metacell_types()$metacell
                globals$clipboard <- selected_metacells
                showNotification(glue("Copied {length(selected_metacells)} metacells to clipboard"))
            })

            observeEvent(input$reset_cell_type_colors, {
                cell_type_colors(get_cell_type_data(dataset()))
            })

            output$annotation_box <- renderUI({
                if (nrow(selected_metacell_types()) == 0) {
                    textOutput(ns("please_select_metacells"))
                } else {
                    list(
                        textOutput(ns("number_of_selected_metacells")),
                        actionButton(ns("update_annotation"), "Apply"),
                        actionButton(ns("reset_annotation"), "Reset Selection"),
                        actionButton(ns("create_new_cell_type"), "Create New Cell Type"),
                        shinyWidgets::radioGroupButtons(
                            inputId = ns("update_option"),
                            label = "",
                            choices = c(
                                "Change all",
                                "Change selected"
                            ),
                            justified = TRUE
                        )
                    )
                }
            })

            output$number_of_selected_metacells <- renderPrint(glue("Selected {nrow(selected_metacell_types())} metacells"))
            output$please_select_metacells <- renderPrint(glue("Please select metacells"))

            output$update_all_selectors <- renderUI({
                req(nrow(selected_metacell_types()) > 0)
                shinyWidgets::pickerInput(ns("selected_cell_type_update_all"), "Cell type", choices = c("(Missing)", cell_type_colors() %>% pull(cell_type) %>% as.character() %>% unique() %>% sort()), multiple = FALSE, selected = last_chosen_cell_type())
            })


            observeEvent(input$update_annotation, {
                new_metacell_types <- metacell_types()
                changed <- FALSE

                req(input$update_option)
                req(input$selected_cell_type_update_all)
                req(selected_metacell_types())

                if (input$update_option == "Change all") {
                    req(input$mc_type_table_rows_all)
                    metacells <- selected_metacell_types()[input$mc_type_table_rows_all, ] %>% pull(metacell)
                } else {
                    req(input$mc_type_table_rows_selected)
                    metacells <- selected_metacell_types()[input$mc_type_table_rows_selected, ] %>% pull(metacell)
                }

                new_metacell_types <- new_metacell_types %>% mutate(
                    cell_type = ifelse(metacell %in% metacells, input$selected_cell_type_update_all, cell_type)
                )
                new_selected_annot <- selected_metacell_types()
                new_selected_annot <- new_selected_annot %>% mutate(
                    cell_type = ifelse(metacell %in% metacells, input$selected_cell_type_update_all, cell_type),
                )
                selected_metacell_types(new_selected_annot)
                last_chosen_cell_type(input$selected_cell_type_update_all)
                changed <- TRUE

                if (changed) {
                    metacell_types(new_metacell_types)
                }

                req(input$reset_on_apply)
                if (input$reset_on_apply) {
                    selected_metacell_types(tibble(metacell = character(), cell_type = character()))
                    to_show(NULL)
                }
            })

            observeEvent(input$reset_annotation, {
                selected_metacell_types(tibble(metacell = character(), cell_type = character()))
                to_show(NULL)
            })

            observeEvent(input$create_new_cell_type, {
                req(selected_metacell_types())
                req(nrow(selected_metacell_types()) > 0)

                showModal({
                    suggested_color <- sample(chameleon::distinct_colors(nrow(cell_type_colors()))$name, 1)
                    modalDialog(
                        title = "Create a new cell type",
                        textInput(ns("new_cell_type_name_from_selection"), "Cell type name"),
                        colourpicker::colourInput(ns("new_cell_type_color_from_selection"), NULL, suggested_color),
                        footer = tagList(
                            modalButton("Cancel"),
                            actionButton(ns("add_cell_type_from_selection"), "Create a new cell type and add the selected metacells to it")
                        )
                    )
                })
            })

            observeEvent(input$add_cell_type_from_selection, {
                req(input$new_cell_type_name_from_selection)
                req(input$new_cell_type_color_from_selection)
                req(selected_metacell_types())
                req(nrow(selected_metacell_types()) > 0)

                if (input$new_cell_type_name_from_selection %in% cell_type_colors()$cell_type) {
                    showNotification(glue("Cell type {input$new_cell_type_name_from_selection} already exists"), type = "error")
                    removeModal()
                    req(FALSE)
                }

                # Add the new cell type to cell_type_colors
                new_cell_type_colors <- cell_type_colors()
                new_row <- tibble(
                    cell_type = input$new_cell_type_name_from_selection,
                    color = input$new_cell_type_color_from_selection,
                    order = max(new_cell_type_colors$order) + 1
                )

                new_cell_type_colors <- bind_rows(
                    new_cell_type_colors,
                    new_row
                ) %>%
                    arrange(order) %>%
                    distinct(cell_type, .keep_all = TRUE) %>%
                    mutate(order = 1:n())

                cell_type_colors(new_cell_type_colors)

                # Update the metacell types for the selected metacells
                if (input$update_option == "Change all") {
                    req(input$mc_type_table_rows_all)
                    metacells <- selected_metacell_types()[input$mc_type_table_rows_all, ] %>% pull(metacell)
                } else {
                    req(input$mc_type_table_rows_selected)
                    metacells <- selected_metacell_types()[input$mc_type_table_rows_selected, ] %>% pull(metacell)
                }

                new_metacell_types <- metacell_types() %>% mutate(
                    cell_type = ifelse(metacell %in% metacells, input$new_cell_type_name_from_selection, cell_type)
                )

                metacell_types(new_metacell_types)

                # Update the selected metacell types
                new_selected_annot <- selected_metacell_types() %>% mutate(
                    cell_type = ifelse(metacell %in% metacells, input$new_cell_type_name_from_selection, cell_type)
                )

                selected_metacell_types(new_selected_annot)
                last_chosen_cell_type(input$new_cell_type_name_from_selection)

                # Add the new cell type to selected_cell_types for filtering
                selected_cell_types(unique(c(selected_cell_types(), input$new_cell_type_name_from_selection)))

                # Reset selection if needed
                if (!is.null(input$reset_on_apply) && input$reset_on_apply) {
                    selected_metacell_types(tibble(metacell = character(), cell_type = character()))
                    to_show(NULL)
                }

                removeModal()

                # Show a success notification
                showNotification(glue("Created new cell type '{input$new_cell_type_name_from_selection}' and assigned {length(metacells)} metacells to it"),
                    type = "message"
                )
            })


            observe({
                req(metacell_types)
                if (nrow(selected_metacell_types()) == 0) {
                    to_show(NULL)
                }

                req(nrow(selected_metacell_types()) != 0)
                to_show_new <- metacell_types() %>%
                    select(metacell, cell_type) %>%
                    filter(metacell %in% selected_metacell_types()$metacell)

                to_show(to_show_new)
            })

            output$mc_type_table <- DT::renderDataTable(
                to_show(),
                escape = FALSE,
                server = FALSE,
                rownames = FALSE,
                filter = "top",
                options = list(
                    dom = "t",
                    paging = FALSE,
                    language = list(emptyTable = "Please select metacells")
                )
            )

            output$cell_type_table <- DT::renderDataTable(
                DT::datatable(cell_type_colors() %>% select(cell_type, color),
                    editable = "cell",
                    rownames = FALSE,
                    options = list(
                        paging = FALSE
                    )
                ) %>%
                    DT::formatStyle(
                        "color", "cell_type",
                        backgroundColor = DT::styleEqual(
                            cell_type_colors()$cell_type,
                            col2hex(cell_type_colors()$color)
                        )
                    ),
                server = TRUE # see https://github.com/rstudio/DT/issues/598
            )

            observeEvent(input$merge_cell_types_modal, {
                rows <- input$cell_type_table_rows_selected
                req(rows)
                cell_types <- cell_type_colors()$cell_type[input$cell_type_table_rows_selected]
                default_color <- cell_type_colors()$color[input$cell_type_table_rows_selected[1]]
                showModal({
                    modalDialog(
                        title = "Merge cell types",
                        textInput(ns("new_merged_cell_type_name"), "Cell type name"),
                        colourpicker::colourInput(ns("new_merged_cell_type_color"), NULL, default_color),
                        glue("Are you sure you want to merge the following cell types: {paste(cell_types, collapse = ',')}?"),
                        footer = tagList(
                            modalButton("Cancel"),
                            actionButton(ns("merge_cell_types"), "OK")
                        )
                    )
                })
            })

            observeEvent(input$merge_cell_types, {
                rows <- input$cell_type_table_rows_selected
                req(rows)
                cell_types <- cell_type_colors()$cell_type[input$cell_type_table_rows_selected]
                req(input$new_merged_cell_type_name)
                req(input$new_merged_cell_type_color)
                if (input$new_merged_cell_type_name %in% cell_type_colors()$cell_type[-rows]) {
                    showNotification(glue("Cell type {input$new_merged_cell_type_name} already exists"), type = "error")
                    removeModal()
                    req(FALSE)
                }

                new_cell_type_colors <- cell_type_colors() %>%
                    filter(!(cell_type %in% cell_types)) %>%
                    tibble::add_row(cell_type = input$new_merged_cell_type_name, color = input$new_merged_cell_type_color, order = rows[1], .before = rows[1]) %>%
                    arrange(order) %>%
                    distinct(cell_type, .keep_all = TRUE) %>%
                    mutate(order = 1:n())

                cell_type_colors(new_cell_type_colors)

                new_metacell_types <- metacell_types() %>%
                    mutate(cell_type = ifelse(cell_type %in% cell_types, input$new_merged_cell_type_name, cell_type))
                metacell_types(new_metacell_types)

                selected_cell_types(unique(c(selected_cell_types(), input$new_merged_cell_type_name)))

                removeModal()
            })

            observeEvent(input$delete_cell_type_colors_modal, {
                req(input$cell_type_table_rows_selected)

                cell_types <- paste(cell_type_colors()$cell_type[input$cell_type_table_rows_selected], collapse = ", ")
                showModal({
                    modalDialog(
                        title = "Remove cell type(s)",
                        glue("Are you sure you want to delete the following cell types: {cell_types}?"),
                        footer = tagList(
                            modalButton("Cancel"),
                            actionButton(ns("delete_cell_type_colors"), "OK")
                        )
                    )
                })
            })

            observeEvent(input$delete_cell_type_colors, {
                rows <- input$cell_type_table_rows_selected

                if (!is.null(rows) && length(rows) > 0) {
                    to_delete <- cell_type_colors()[rows, ]
                    cell_type_colors(cell_type_colors()[-rows, ])
                    metacell_types(
                        metacell_types() %>%
                            mutate(
                                cell_type = ifelse(cell_type %in% to_delete$cell_type, NA, cell_type),
                            )
                    )
                }
                removeModal()
            })

            observeEvent(input$rename_cell_type_colors_modal, {
                req(input$cell_type_table_rows_selected)
                req(length(input$cell_type_table_rows_selected) == 1)

                cell_type <- cell_type_colors()$cell_type[input$cell_type_table_rows_selected]
                showModal({
                    modalDialog(
                        title = "Rename cell type",
                        textInput(ns("new_cell_type_name"), "Cell type name", value = cell_type),
                        footer = tagList(
                            modalButton("Cancel"),
                            actionButton(ns("rename_cell_type_colors"), "OK")
                        )
                    )
                })
            })

            observeEvent(input$rename_cell_type_colors, {
                req(input$cell_type_table_rows_selected)
                req(length(input$cell_type_table_rows_selected) == 1)

                cell_type <- cell_type_colors()$cell_type[input$cell_type_table_rows_selected]
                req(input$new_cell_type_name)
                if (input$new_cell_type_name %in% cell_type_colors()$cell_type[-input$cell_type_table_rows_selected]) {
                    showNotification(glue("Cell type {input$new_cell_type_name} already exists"), type = "error")
                    removeModal()
                    req(FALSE)
                }

                new_cell_type_colors <- cell_type_colors() %>%
                    mutate(cell_type = ifelse(cell_type == !!cell_type, input$new_cell_type_name, cell_type))
                cell_type_colors(new_cell_type_colors)

                new_metacell_types <- metacell_types() %>%
                    mutate(cell_type = ifelse(cell_type == !!cell_type, input$new_cell_type_name, cell_type))
                metacell_types(new_metacell_types)

                selected_cell_types(unique(c(selected_cell_types(), input$new_cell_type_name)))

                removeModal()
            })


            observeEvent(input$add_cell_type_modal, {
                showModal({
                    suggested_color <- sample(chameleon::distinct_colors(nrow(cell_type_colors()))$name, 1)
                    modalDialog(
                        title = "Add a new cell type",
                        textInput(ns("new_cell_type_name"), "Cell type name"),
                        colourpicker::colourInput(ns("new_cell_type_color"), NULL, suggested_color),
                        footer = tagList(
                            modalButton("Cancel"),
                            actionButton(ns("add_cell_type"), "OK")
                        )
                    )
                })
            })

            observeEvent(input$add_cell_type, {
                req(input$new_cell_type_name)
                req(input$new_cell_type_color)
                if (input$new_cell_type_name %in% cell_type_colors()$cell_type) {
                    showNotification(glue("Cell type {input$new_cell_type_name} already exists"), type = "error")
                    removeModal()
                    req(FALSE)
                }

                rows <- input$cell_type_table_rows_selected
                if (!is.null(rows) && length(rows) > 0) {
                    place <- rows[1] + 1
                } else {
                    place <- 1
                }

                new_data <- cell_type_colors() %>% arrange(order)

                new_row <- tibble(cell_type = input$new_cell_type_name, color = input$new_cell_type_color, order = place)
                new_data <- bind_rows(
                    new_data %>% filter(order < place),
                    new_row,
                    new_data %>% filter(order >= place) %>% mutate(order = order + 1)
                )

                new_data <- new_data %>%
                    arrange(order) %>%
                    distinct(cell_type, .keep_all = TRUE) %>%
                    mutate(order = 1:n())
                cell_type_colors(new_data)

                selected_cell_types(unique(c(selected_cell_types(), input$new_cell_type_name)))
                removeModal()
            })

            output$annot_color_picker <- renderUI({
                fluidRow(
                    column(2, actionButton(ns("submit_new_color"), "Change color")),
                    column(2, colourpicker::colourInput(ns("selected_new_color"), NULL, "black")),
                    column(2, actionButton(ns("delete_cell_type_colors_modal"), "Delete")),
                    column(2, actionButton(ns("rename_cell_type_colors_modal"), "Rename")),
                    column(2, actionButton(ns("merge_cell_types_modal"), "Merge")),
                    column(1,
                        style = "padding:0; margin:0;",
                        shinyjs::hidden(actionButton(ns("move_cell_type_up"), "",
                            icon = icon("arrow-up"),
                            style = "padding:6px 8px; margin:0;"
                        ))
                    ),
                    column(1,
                        style = "padding:0; margin:0;",
                        shinyjs::hidden(actionButton(ns("move_cell_type_down"), "",
                            icon = icon("arrow-down"),
                            style = "padding:6px 8px; margin:0;"
                        ))
                    )
                )
            })

            observe({
                shinyjs::toggle(id = "submit_new_color", condition = !is.null(input$cell_type_table_rows_selected))
                shinyjs::toggle(id = "selected_new_color", condition = !is.null(input$cell_type_table_rows_selected))
                shinyjs::toggle(id = "delete_cell_type_colors_modal", condition = !is.null(input$cell_type_table_rows_selected))
                shinyjs::toggle(id = "rename_cell_type_colors_modal", condition = !is.null(input$cell_type_table_rows_selected) && length(input$cell_type_table_rows_selected) == 1)
                shinyjs::toggle(id = "merge_cell_types_modal", condition = !is.null(input$cell_type_table_rows_selected) && length(input$cell_type_table_rows_selected) > 1)
                shinyjs::toggle(id = "move_cell_type_up", condition = !is.null(input$cell_type_table_rows_selected))
                shinyjs::toggle(id = "move_cell_type_down", condition = !is.null(input$cell_type_table_rows_selected))
            })

            observe({
                req(input$cell_type_table_rows_selected)
                row <- utils::tail(input$cell_type_table_rows_selected, n = 1)
                colourpicker::updateColourInput(session, "selected_new_color", value = cell_type_colors()$color[row])
            })

            observeEvent(input$submit_new_color, {
                rows <- input$cell_type_table_rows_selected
                new_data <- cell_type_colors()
                new_data$color[rows] <- input$selected_new_color
                cell_type_colors(new_data)
            })

            # Add observers for the up and down buttons
            observeEvent(input$move_cell_type_up, {
                req(input$cell_type_table_rows_selected)

                # Get the selected rows
                selected_rows <- sort(input$cell_type_table_rows_selected)

                # Can't move up if the first selected row is already at the top
                if (min(selected_rows) > 1) {
                    new_data <- cell_type_colors()

                    # Find the minimum order value of the selection
                    min_order <- min(new_data$order[selected_rows])

                    # Find the row with order value just before min_order
                    row_above <- which(new_data$order == (min_order - 1))

                    # If there are consecutive selected rows, we only need to swap with the row above the top selection
                    if (length(row_above) == 1) {
                        # Get all selected cell types
                        selected_cell_types <- new_data$cell_type[selected_rows]

                        # Get the cell type that needs to move down
                        above_cell_type <- new_data$cell_type[row_above]

                        # Create a temporary order column to preserve relative positions
                        new_data <- new_data %>%
                            mutate(temp_order = order)

                        # Move the above cell type down below all selected rows
                        new_data$temp_order[row_above] <- min_order + length(selected_rows) - 1

                        # Move all selected rows up by 1
                        new_data$temp_order[selected_rows] <- new_data$temp_order[selected_rows] - 1

                        # Update the order column and sort
                        new_data <- new_data %>%
                            mutate(order = rank(temp_order, ties.method = "first")) %>%
                            select(-temp_order) %>%
                            arrange(order)

                        # Update the data
                        cell_type_colors(new_data)

                        # Find the new indices of the selected cell types
                        new_indices <- which(new_data$cell_type %in% selected_cell_types)

                        # Update the selection to follow the moved rows
                        shinyjs::delay(100, {
                            DT::selectRows(DT::dataTableProxy("cell_type_table"), new_indices)
                        })
                    }
                }
            })

            observeEvent(input$move_cell_type_down, {
                req(input$cell_type_table_rows_selected)

                # Get the selected rows
                selected_rows <- sort(input$cell_type_table_rows_selected)

                new_data <- cell_type_colors()
                total_rows <- nrow(new_data)

                # Can't move down if the last selected row is already at the bottom
                if (max(selected_rows) < total_rows) {
                    # Find the maximum order value of the selection
                    max_order <- max(new_data$order[selected_rows])

                    # Find the row with order value just after max_order
                    row_below <- which(new_data$order == (max_order + 1))

                    # If there are consecutive selected rows, we only need to swap with the row below the bottom selection
                    if (length(row_below) == 1) {
                        # Get all selected cell types
                        selected_cell_types <- new_data$cell_type[selected_rows]

                        # Get the cell type that needs to move up
                        below_cell_type <- new_data$cell_type[row_below]

                        # Create a temporary order column to preserve relative positions
                        new_data <- new_data %>%
                            mutate(temp_order = order)

                        # Move the below cell type up above all selected rows
                        new_data$temp_order[row_below] <- max_order - length(selected_rows) + 1

                        # Move all selected rows down by 1
                        new_data$temp_order[selected_rows] <- new_data$temp_order[selected_rows] + 1

                        # Update the order column and sort
                        new_data <- new_data %>%
                            mutate(order = rank(temp_order, ties.method = "first")) %>%
                            select(-temp_order) %>%
                            arrange(order)

                        # Update the data
                        cell_type_colors(new_data)

                        # Find the new indices of the selected cell types
                        new_indices <- which(new_data$cell_type %in% selected_cell_types)

                        # Update the selection to follow the moved rows
                        shinyjs::delay(100, {
                            DT::selectRows(DT::dataTableProxy("cell_type_table"), new_indices)
                        })
                    }
                }
            })

            # Select metacell when clicking on it
            observe_mc_click_event("proj_annot_plot", input, session, cell_type_colors, metacell_types, selected_metacell_types)
            observe_mc_click_event("gene_gene_plot_annot", input, session, cell_type_colors, metacell_types, selected_metacell_types)
            observe_mc_click_event("gene_time_mc_plot1_annot", input, session, cell_type_colors, metacell_types, selected_metacell_types)
            observe_mc_click_event("gene_time_mc_plot2_annot", input, session, cell_type_colors, metacell_types, selected_metacell_types)

            # Select multiple metacells
            observer_mc_select_event("proj_annot_plot", input, cell_type_colors, metacell_types, selected_metacell_types)
            observer_mc_select_event("gene_gene_plot_annot", input, cell_type_colors, metacell_types, selected_metacell_types)
            observer_mc_select_event("gene_time_mc_plot1_annot", input, cell_type_colors, metacell_types, selected_metacell_types)
            observer_mc_select_event("gene_time_mc_plot2_annot", input, cell_type_colors, metacell_types, selected_metacell_types)

            projection_selectors(ns, dataset, output, input, gene_modules, globals, session, weight = 0.6)
            scatter_selectors(ns, dataset, output, globals)

            # Projection plots
            output$plot_gene_proj_2d <- render_2d_plotly(
                input,
                output,
                session,
                dataset,
                metacell_types,
                cell_type_colors,
                gene_modules,
                globals,
                source = "proj_annot_plot",
                buttons = c("hoverClosestCartesian", "hoverCompareCartesian", "toggleSpikelines"),
                dragmode = "select",
                selected_metacell_types = selected_metacell_types,
                selected_cell_types = selected_cell_types
            )

            selected_cell_types <- reactiveVal(NULL)
            scatter_box_outputs(input, output, session, dataset, metacell_types, cell_type_colors, gene_modules, globals, ns, selected_cell_types = selected_cell_types, plotly_source = "gene_gene_plot_annot", plotly_buttons = c("hoverClosestCartesian", "hoverCompareCartesian", "toggleSpikelines"), dragmode = "select")

            connect_gene_plots(input, output, session, ns, source = "proj_annot_plot")

            # MC/MC diff gene expression plots
            diff_expr_outputs(input, output, session, dataset, metacell_types, cell_type_colors, gene_modules, globals, ns, source_suffix = "_annot")

            mod_gene_mc_plotly_observers(input, session, source = "mc_mc_plot_annot", notification_suffix = "")
        }
    )
}


observe_mc_click_event <- function(source, input, session, cell_type_colors, metacell_types, selected_metacell_types) {
    observeEvent(plotly::event_data("plotly_click", source = source), {
        el <- plotly::event_data("plotly_click", source = source)

        selected_metacell <- el$customdata

        new_selected_annot <- metacell_types() %>% filter(metacell == selected_metacell)

        selected_metacell_types(
            bind_rows(
                selected_metacell_types(),
                new_selected_annot
            ) %>% distinct(metacell, cell_type)
        )

        shinyWidgets::updatePickerInput(session, "metacell1", selected = selected_metacell)
    })
}

observer_mc_select_event <- function(source, input, cell_type_colors, metacell_types, selected_metacell_types) {
    observeEvent(plotly::event_data("plotly_selected", source = source), {
        el <- plotly::event_data("plotly_selected", source = source)

        selected_metacells <- unique(el$customdata)

        new_selected_annot <- metacell_types() %>% filter(metacell %in% selected_metacells)
        if (!is.null(input$add_to_selection) && input$add_to_selection) {
            selected_metacell_types(
                bind_rows(
                    selected_metacell_types(),
                    new_selected_annot
                ) %>% distinct(metacell, cell_type)
            )
        } else {
            selected_metacell_types(new_selected_annot %>% distinct(metacell, cell_type))
        }
    })
}