R/mod_allele_frequency.R

In teofiln/gene.editing.dash: VOR Gene Editing Dashboard

#' allele_frequency UI Function
#'
#' @description A shiny Module.
#'
#' @param id,input,output,session Internal parameters for {shiny}.
#'
#' @noRd
#'
#' @importFrom shiny NS tagList
mod_allele_frequency_ui <- function(id) {
  ns <- NS(id)

  tagList(column(
    width = 12,
    shiny::div(
      class = "row g-3 justify-content-start",
      shiny::div(class = "d-inline p-2",
                 mod_sample_meta_filters_ui(ns(
                   "allele_freq_filters"
                 ))),
      shiny::div(
        class = "d-inline p-2",
        shinyWidgets::dropMenu(
          arrow = FALSE,
          tag = shiny::actionButton(
            inputId = ns("configure"),
            label = "Configure",
            icon = shiny::icon("cogs"),
            class = "btn-primary"
          ),
          shiny::tagList(
            shiny::div(
              class = "compact-dropdown",
              custom_picker_menu(
                .id = ns("cols_to_hide"),
                .label = "Set visible columns",
                .choices = NULL,
                selected = NULL,
                multiple = TRUE,
                width = "100%"
              )
            ),
            shiny::div(
              class = "compact-dropdown",
              custom_picker_menu(
                .id = ns("cols_for_group"),
                .label = "Set grouping columns",
                .choices = NULL,
                selected = NULL,
                multiple = TRUE,
                width = "100%"
              )
            ),
              shiny::div(
                class = "compact-dropdown",
                shinyWidgets::spectrumInput(
                  inputId = ns("qc_color_1"),
                  selected = "steelblue",
                  label = "Color for low values",
                  choices = list(
                    list("#706699", "#8498b9", "#FFFFFF"),
                    list('black', 'white', 'steelblue', 'forestgreen', 'firebrick')
                  ),
                  options = list(`toggle-palette-more-text` = "Show more")
                )
              ),
              shiny::div(
                class = "compact-dropdown",
                shinyWidgets::spectrumInput(
                  inputId = ns("qc_color_2"),
                  selected = "firebrick",
                  label = "Color for high values",
                  choices = list(
                    list("#706699", "#8498b9", "#FFFFFF"),
                    list('black', 'white', 'steelblue', 'forestgreen', 'firebrick')
                  ),
                  options = list(`toggle-palette-more-text` = "Show more")
                )
              )
          )
        )
      ),
      shiny::div(
        class = "d-inline p-2",
        shinyWidgets::dropMenu(
          arrow = FALSE,
          maxWidth = "300px",
          tag = shiny::actionButton(
            inputId = ns("help"),
            label = "Help",
            icon = shiny::icon("info-circle"),
            class = "btn-primary"
          ),
          shiny::includeMarkdown("inst/md/read_qc_help.md")
        )
      )
    ),
    shiny::hr(),
    shiny::column(width = 12,
                  DT::DTOutput(outputId = ns(
                    "allele_freq_tbl"
                  )))
  ))
}

#' allele_frequency Server Functions
#'
#' @noRd
mod_allele_frequency_server <- function(id, app_data) {
  moduleServer(id, function(input, output, session) {
    ns <- session$ns

    filters_out <-
      mod_sample_meta_filters_server(id = "allele_freq_filters",
                                     app_data = app_data,
                                     target_table = "AppAllele")
    RV <- shiny::reactive({
      filters_out$get()
    })

    # Update the options in the dropdown for column visibility
    gargoyle::on(name = "new_project_selected", expr = {
      shinyWidgets::updatePickerInput(
        session = session,
        inputId = "cols_to_hide",
        choices = RV()$dropdown_options$ColsToHideOptions,
        selected = RV()$dropdown_options$ColsToHideSelected
      )
    })

    shiny::observe({
      options <- setNames(
        seq_along(find_possible_meta_columns(RV()$data_to_render)),
        find_possible_meta_columns(RV()$data_to_render)
      )

      shinyWidgets::updatePickerInput(
        session = session,
        inputId = "cols_for_group",
        choices = options,
        selected = NULL
      )
    }) %>% shiny::bindEvent({
      RV()$data_to_render
    })

    # Create a list of columns to hide based on user selection
    cols_to_hide <- shiny::reactive({
      setdiff(seq_along(names(app_data$app_list$AppAllele)), input$cols_to_hide)
    }) %>% shiny::bindEvent(input$cols_to_hide)

    # Create options list for row grouping
    cols_for_group <- shiny::reactive({
      if (is.null(input$cols_for_group)) {
        NULL
      } else {
        list(dataSrc = input$cols_for_group)
      }
    })

    # Create options list for sorting
    cols_for_sort <- shiny::reactive({
      if (is.null(input$cols_for_group)) {
        NULL
      } else {
        lapply(input$cols_for_group,
               \(x)
               list(x, "asc"))
      }
    })

    output$allele_freq_tbl <- DT::renderDT(server = FALSE, {
      shiny::validate(
        shiny::need(shiny::isTruthy(app_data$project),
                    message = "Please select a project in the `Project selection' tab.")
      )

      shiny::validate(
        shiny::need(nrow(RV()$data_to_render) > 0, message = "Found no data matching your query. Please adjust your filters.")
      )

      # app_data$app_list$AppAllele %>%
      RV()$data_to_render %>%
        janitor::clean_names(case = "sentence") %>%
        dplyr::rename(`Indel+Subs` = `Indel subs`, `Grand Total` = "Grand total") %>%
        dt_gradient(
          columns = c("Indel", "Indel+Subs", "Subs", "Grand Total"),
          colors = c(input$qc_color_1, input$qc_color_2),
          class = "compact nowrap",
          gradient_type = "gradient",
          selection = "none",
          extensions = c("Buttons", "ColReorder", "RowGroup"),
          options = list(
            dom = 'lfrtipB',
            selection = "none",
            rowGroup = cols_for_group(),
            order = cols_for_sort(),
            colReorder = TRUE,
            columnDefs = list(list(
              visible = FALSE, targets = cols_to_hide()
            )),
            scrollX = T,
            pageLength = 100,
            lengthMenu = c(25, 50, 100, nrow(RV()$data_to_render)),
            buttons = buttons_for_dt(input$cols_to_hide)
          )
        )
      # %>%
      #   DT::formatString(table = .,
      #                    suffix = "%",
      #                    columns = c("Percent aligned", "Percent usable total reads")
      #   )

    })


    # restore session for this module
    shiny::onRestored(function(state) {
      shiny::withProgress(message = "Restoring session. Please wait",
                          expr = {
                            shinyWidgets::updatePickerInput(
                              session = session,
                              inputId = "cols_to_hide",
                              choices = RV()$dropdown_options$ColsToHideOptions,
                              selected = state$input$cols_to_hide
                            )

                            options <- setNames(
                              seq_along(find_possible_meta_columns(RV()$data_to_render)),
                              find_possible_meta_columns(RV()$data_to_render)
                            )

                            shinyWidgets::updatePickerInput(
                              session = session,
                              inputId = "cols_for_group",
                              choices = options,
                              selected = state$input$cols_for_group
                            )
                          })

    })
  })
}