gene.editing.dash: VOR Gene Editing Dashboard

#' seq_alignment UI Function
#'
#' @description A shiny Module.
#'
#' @param id,input,output,session Internal parameters for {shiny}.
#'
#' @noRd
#'
#' @importFrom shiny NS tagList
mod_seq_alignment_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"
                   ),
                   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",
                     custom_picker_menu(
                       .id = ns("color_by"),
                       .label = "Set color-coding variable",
                       .choices = c("NumberOfReads", "PctReads"),
                       selected = "PctReads",
                       multiple = FALSE,
                       width = "100%"
                     )
                   ),
                   shiny::div(
                     class = "compact-dropdown",
                     shiny::numericInput(
                       inputId = ns("n_alns_to_show"),
                       label = "Alignments to show",
                       value = 6,
                       min = 1,
                       max = 20,
                       step = 1)
                   ),
                   shiny::div(
                     class = "compact-dropdown",
                     custom_picker_menu(
                       .id = ns("align_length"),
                       .label = "Set alignment_length",
                       .choices = c("10", "20", "30"),
                       selected = "30",
                       multiple = FALSE,
                       width = "100%"
                     )),
                     shiny::div(
                       class = "d-inline p-2",
                       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 = "d-inline p-2",
                       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(),
    DT::DTOutput(ns("seq_aln_tbl"))
  ))
}

#' seq_alignment Server Functions
#'
#' @noRd
mod_seq_alignment_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 = "AppAlign")
    RV <- shiny::reactive({
      filters_out$get()
    })

    D_reshaped <- shiny::reactive({

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

      reshape_alignment_data(
        .data = RV()$data_to_render,
        .n_bp = input$align_length,
        .scale_by = input$color_by,
        .top_n = input$n_alns_to_show
      )
    })

    shiny::observe({
      options <- setNames(
        seq_along(find_possible_meta_columns(D_reshaped())),
        find_possible_meta_columns(D_reshaped()))

      shinyWidgets::updatePickerInput(
        session = session,
        inputId = "cols_for_group",
        choices = options,
        selected = NULL
      )

      shinyWidgets::updatePickerInput(
        session = session,
        inputId = "cols_to_hide",
        choices = setNames(seq_along(names(D_reshaped())), names(D_reshaped())),
        selected = setNames(seq_along(names(D_reshaped())), names(D_reshaped()))
      )
    }) %>% shiny::bindEvent({ D_reshaped()})

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

    output$seq_aln_tbl <- DT::renderDT(server = TRUE, {
      columns_to_style <- RV()$data_to_render$SampleName %>% unique

      get_col_index <- function(col) {
        seq_along(colnames(D_reshaped()))[colnames(D_reshaped()) %in% col]
      }

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

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

      dt_gradient(
        table = D_reshaped(),
        columns = columns_to_style,
        gradient_type = "gradient",
        class = "compact",
        colors = c(input$qc_color_1, input$qc_color_2),
        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()),
                            list(width = paste0(as.numeric(input$align_length)*7, "px"),
                                 targets = seq_along(names(D_reshaped()))[names(D_reshaped()) == "Alignment"])
                            ),
          scrollX = TRUE,
          scrollY = FALSE,
          pageLength = 100,
          lengthMenu = c(25, 50, 100, nrow(D_reshaped()))

          #,
          # TODO: This table is too big to be loaded into the client, or it can be loaded but it will
          #       slow down the app significantly (shiny throws a warning for this). And if it cannot be
          #       loaded in the browser, we can't have a button for 'download all data' through the DT built-in
          #       mechanism. Therefore, the buttons are disabled. We should generate shiny (not DT) buttons
          #       to download large datasets across the application.
          # buttons = buttons_for_dt(input$cols_to_hide),

          # TODO: JS needs to find the indices of the targets columns for the row callback because when
          #       the columns are hidden, the server (R) is not aware of this and this forces formatting
          #       of the wrong column
          # rowCallback = DT::JS(
          #   make_row_callback(grna = seq_along(names(D_reshaped()))[names(D_reshaped()) == "GrnaSequence"],
          #                     ref = seq_along(names(D_reshaped()))[names(D_reshaped()) == "Alignment"])
          # )
        )
      ) %>%
        DT::formatStyle(
          table = .,
          columns = c("GrnaSequence", "Alignment"),
          target = 'cell',
          fontFamily = "courier",
          fontSize = 2
        ) %>%
        DT::formatStyle(columns = names(D_reshaped()), lineHeight = '80%')
    })

    # restore session for this module
    shiny::onRestored(function(state) {
      shiny::withProgress(message = "Restoring session. Please wait.",
                          expr = {
                            options <- setNames(
                              seq_along(find_possible_meta_columns(D_reshaped())),
                              find_possible_meta_columns(D_reshaped())
                            )

                            named_col_index <- setNames(seq_along(names(D_reshaped())), names(D_reshaped()))

                            shinyWidgets::updatePickerInput(
                              session = session,
                              inputId = "cols_to_hide",
                              choices = named_col_index,
                              selected = named_col_index#[state$input$cols_to_hide]
                            )

                            shinyWidgets::updatePickerInput(
                              session = session,
                              inputId = "cols_for_group",
                              choices = options,
                              selected = options[as.numeric(state$input$cols_for_group)]
                            )
                          })
    })

  })
}

make_row_callback <- function(grna, ref) {
    c(
      "function(row,data) {",
      glue::glue("data[{ref}] = data[{ref}].replace(data[{grna}], '<span style=\"background:#8498b970\">' + data[{grna}] + '</span>');"),
      glue::glue("$('td:eq({ref})', row).html(data[{ref}]);"),
    "}"
  )
}