R/mod_read_qc.R

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

#' read_qc UI Function
#'
#' @description A shiny Module.
#'
#' @param id,input,output,session Internal parameters for {shiny}.
#' @importFrom shiny NS tagList
mod_read_qc_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(
                   "read_qc_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"
          ),
          read_qc_configure_menus(ns = ns),
        )
      ),
      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(),
    DT::DTOutput(ns("read_qc_table"))
  ))
}

#' read_qc Server Functions
#' @param app_data the AppData R6 instance storing data for module communication
mod_read_qc_server <- function(id, app_data) {
  moduleServer(id, function(input, output, session) {
    ns <- session$ns

    filters_out <-
      mod_sample_meta_filters_server(id = "read_qc_filters",
                                     app_data = app_data,
                                     target_table = "AppQCTable")
    RV <- shiny::reactiveVal()
    shiny::observe({
      RV(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(RV()$dropdown_options$ColsToHideOptions,
              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"))
      }
    })

    # Render the filtered table with column visibility per user selections
    output$read_qc_table <- DT::renderDT(server = TRUE, {
      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.")
      )

      RV()$data_to_render %>%
        janitor::clean_names(case = "sentence") %>%
        dt_gradient(
          columns = "Percent usable total reads",
          gradient_type = "gradient",
          colors = c(input$qc_color_1, input$qc_color_2),
          class = "compact nowrap",
          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
                            )
                          })
    })
  })
}

read_qc_configure_menus <- function(ns) {
  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",
          width = "100%",
          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",
          width = "100%",
          choices = list(
            list("#706699", "#8498b9", "#FFFFFF"),
            list('black', 'white', 'steelblue', 'forestgreen', 'firebrick')
          ),
          options = list(`toggle-palette-more-text` = "Show more")
        )
      )
  )
}