R/mod_read_qc_boxplot.R

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

#' read_qc_barplot UI Function
#'
#' @description A shiny Module.
#'
#' @param id,input,output,session Internal parameters for {shiny}.
#'
#' @importFrom shiny NS tagList
mod_read_qc_barplot_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("qc_boxplot_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("xvar"),
                .label = "X axis variable",
                .choices = "SampleName",
                selected = "SampleName",
                multiple = FALSE,
                width = "100%"
              )
            ),
          shiny::div(class = "compact-dropdown",
            custom_picker_menu(
              .id = ns("sort"),
              .label = "Sort by",
              .choices = c("none"),
              selected = "none",
              multiple = FALSE,
              width = "100%"
            )
          ),
          shiny::div(class = "compact-dropdown",
            custom_picker_menu(
              .id = ns("facet"),
              .label = "Facet by",
              .choices = c("none"),
              selected = "none",
              multiple = FALSE,
              width = "100%"
            )
          ),
          shiny::div(class = "compact-dropdown",
            shinyWidgets::spectrumInput(
              inputId = ns("color_1"),
              selected = "steelblue",
              label = "Color for unmodified",
              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("color_2"),
              selected = "firebrick",
              label = "Color for modified",
              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",
            shiny::numericInput(
              inputId = ns("plot_width"),
              label = "Chart width",
              value = 800,
              min = 300,
              max = 2000,
              step = 10
            )
          ),
          shiny::div(class = "compact-dropdown",
            shiny::numericInput(
              inputId = ns("plot_height"),
              label = "Chart height",
              value = 500,
              min = 300,
              max = 800,
              step = 10
            )
          )
          )
        )
      ),
      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/qc_boxplot_help.md"))
    )
  ),
    shiny::hr(),
    plotly::plotlyOutput(ns("read_qc_barplot"))
  ))
}

#' read_qc_barplot Server Functions
#'
mod_read_qc_barplot_server <- function(id, app_data) {
  moduleServer(id, function(input, output, session) {
    ns <- session$ns

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

    shiny::observe({
      dropdown_options <- find_possible_meta_columns(RV()$data_to_render)
      shinyWidgets::updatePickerInput(
        session = session,
        inputId = "xvar",
        label = "X axis variable",
        choices = dropdown_options,
        selected = "SampleName"
      )

      shinyWidgets::updatePickerInput(
        session = session,
        inputId = "sort",
        label = "Sort by",
        choices = c("none", dropdown_options),
        selected = "none"
      )

      shinyWidgets::updatePickerInput(
        session = session,
        inputId = "facet",
        label = "Facet by",
        choices = c("none", dropdown_options),
        selected = "none"
      )
    }) %>% shiny::bindEvent({ RV()$data_to_render })

    plot_to_render <- shiny::reactive({

      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.")
      )

      read_qc_boxplot(
        .data = RV()$data_to_render,
        .group_var = input$xvar,
        .sort_var = input$sort,
        .facet_var = input$facet,
        .colors = c(input$color_1, input$color_2),
        .dims = c(input$plot_width, input$plot_height)
      )
    })

    output$read_qc_barplot <- plotly::renderPlotly({
      plot_to_render()
    })


    shiny::onRestored(function(state) {
      shiny::withProgress(message = "Restoring session. Please wait",
                          expr = {
                            dropdown_options <- find_possible_meta_columns(RV()$data_to_render)

                            shinyWidgets::updatePickerInput(
                              session = session,
                              inputId = "xvar",
                              label = "X axis variable",
                              choices = dropdown_options,
                              selected = state$input$xvar
                            )

                            shinyWidgets::updatePickerInput(
                              session = session,
                              inputId = "color",
                              label = "Color by",
                              choices = c("none", dropdown_options),
                              selected = state$input$color
                            )

                            shinyWidgets::updatePickerInput(
                              session = session,
                              inputId = "sort",
                              label = "Sort by",
                              choices = c("none", dropdown_options),
                              selected = state$input$sort
                            )

                            shinyWidgets::updatePickerInput(
                              session = session,
                              inputId = "facet",
                              label = "Facet by",
                              choices = c("none", dropdown_options),
                              selected = state$input$facet
                            )
                          })

    })
  })
}