R/mod_edit_assesment_plot1.R

Defines functions mod_edit_assesment_plot1_server mod_edit_assesment_plot1_ui

#' edit_assesment_plot1 UI Function
#'
#' @description A shiny Module.
#'
#' @param id,input,output,session Internal parameters for {shiny}.
#'
#' @noRd
#'
#' @importFrom shiny NS tagList
mod_edit_assesment_plot1_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("edit_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("x_var"),
              .label = "X axis",
              .choices = "SampleName",
              selected = "SampleName",
              multiple = FALSE,
              width = "100%"
            )
          ),
          shiny::div(
            class = "compact-dropdown",
            custom_picker_menu(
              .id = ns("color_var"),
              .label = "Color by",
              .choices = "none",
              selected = "none",
              multiple = FALSE,
              width = "100%"
            )
          ),
          shiny::div(
            class = "compact-dropdown",
            custom_picker_menu(
              .id = ns("facet_var"),
              .label = "Facet by",
              .choices = "none",
              selected = "none",
              multiple = FALSE,
              width = "100%"
            )
          ),
          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 = 2000,
              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/read_qc_help.md")
        )
      )
    ),
    shiny::hr(),
    plotly::plotlyOutput(outputId = ns("edit_assessment_1"))
  ))
}

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

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

    # Update the options in the dropdowns for configuration

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

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

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

   output$edit_assessment_1 <- plotly::renderPlotly({
     shiny::req(input$x_var, input$facet_var, input$color_var)

     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 %>%
       dplyr::mutate(ModifiedPct = round(as.numeric(ModifiedPct), 2)) %>%
       make_boxplot_w_jitter_and_grouping(
         .xvar = input$x_var,
         .yvar = "ModifiedPct",
         .gvar = input$color_var,
         .fvar = input$facet_var,
         .dims = c(input$plot_width, input$plot_height)
       )
   })

   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 = "x_var",
                             label = "X axis",
                             choices = dropdown_options,
                             selected = state$input$x_var
                           )

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

                           shinyWidgets::updatePickerInput(
                             session = session,
                             inputId = "facet_var",
                             label = "Facet by",
                             choices = c("none", dropdown_options),
                             selected = state$input$facet_var
                           )
                         })
   })
  })
}
teofiln/gene.editing.dash documentation built on Feb. 21, 2022, 12:59 a.m.