R/module_design_run.R

In MicrobialGenomics/covidseq:

#' Title
#'
#' @param id identification
#'
#' @export
design_run_module_ui <- function(id) {
    shiny::pageWithSidebar(
        shiny::headerPanel(""),

        # sidebar
        shiny::sidebarPanel(
            width = 3,
            shiny::radioButtons(
                inputId = shiny::NS(id, "arrange"),
                label = "Arrange by:",
                choices = list(
                    "Originating Lab" = "submitting_lab_name",
                    "Sumit date" = "submit_date",
                    "Collection date" = "collection_date",
                    "Sample source" = "original_source",
                    "Sample shared type" = "sample_shared_type",
                    "Ct" = "pcr_cycle_threshold",
                    "Patient" = "patient_id"
                ),
                selected = "submit_date",
                width = 300
            ),
            shiny::hr(),
            shiny::sliderInput(
                inputId = shiny::NS(id, "n_samples"),
                label = "Number of samples to process?",
                min = 1,
                max = 96,
                value = 10,
                round = TRUE,
                width = 300
            ),
            shiny::hr(),
            shiny::actionButton(
                inputId = shiny::NS(id, "design_run"),
                label = "Design a run",
                shiny::icon("table"),
                width = 140
            ),
            shiny::hr(),
            shiny::downloadButton(
                outputId = shiny::NS(id, "download_data"),
                label = "Download csv",
                icon = shiny::icon("table")
            ),
            shiny::br()
        ),

        # main
        shiny::mainPanel(
            shiny::fluidRow(
                shiny::h3("Pending samples"),
                DT::dataTableOutput(shiny::NS(id, "table_1")),
                shiny::h3("Designed run"),
                DT::dataTableOutput(shiny::NS(id, "table_2"))
            )
        )
    )
}

#' Title
#'
#' @param id identification
#'
#' @export
design_run_module_server <- function(id) {
    shiny::moduleServer(id, function(input, output, session) {

        # micellanius
        shinyjs::disable("download_data")
        to_select <- c(
            "library_id",
            "sample_id",
            "original_sample_id",
            "run_id",
            "design_date",
            "s5barcode",
            "n7barcode"
        )

        # Load data file reactivity
        df_all <- shiny::reactive({
            samples_to_lib() %>%
                dplyr::arrange(dplyr::across(dplyr::contains(input$arrange))) %>%
                dplyr::slice_head(n = input$n_samples)
        })

        # Print datatable with order and n samples
        output$table_1 <- DT::renderDataTable({
            if (!is.null(df_all())) {
                df_all() %>%
                    dplyr::select(2:13) %>%
                    DT::datatable(escape = FALSE,
                                  options = list(
                                      pageLength = -1
                                  ))
            }
        })

        # Design run button
        df_run <- shiny::eventReactive(input$design_run, {
            shinyjs::enable("download_data")
            shinyjs::disable("design_run")
            shinyjs::disable("n_samples")
            shinyjs::disable("arrange")

            # df with selected information and push to MySQL
            df <- df_all() %>%
                dplyr::select(dplyr::all_of(to_select)) %>%
                dplyr::select(-original_sample_id, -s5barcode, -n7barcode)
            #df  %>% ingest_db("run_design")
            df
        })

        ## Print designed run
        output$table_2 <- DT::renderDataTable({
            if (!is.null(df_run())) {
                df_run() %>%
                    DT::datatable(escape = FALSE,
                                  options = list(
                                      pageLength = -1
                                  ))
            }
        })

        # Export designed run in .csv
        output$download_data <- shiny::downloadHandler(
            filename = glue::glue(
                "samples_to_process_{df_all() %>% dplyr::select(dplyr::all_of(to_select)) %>% dplyr::pull(run_id) %>% unique() }.csv"
            ),
            content = function(file) {
                readr::write_csv(x = df_all() %>% dplyr::select(dplyr::all_of(to_select)), file = file)
            }
        )
    })
}

#' Title
#'
#' @return tibble
#' @export
samples_to_lib <- function() {
    cn <- connect_db("mysql_covid_seq")
    on.exit(DBI::dbDisconnect(cn))
    sql_samples_df <- dplyr::tbl(cn, "samples") %>% tibble::as_tibble()
    sql_libs_df <- dplyr::tbl(cn, "run_design") %>%
        tibble::as_tibble() %>%
        dplyr::filter(stringr::str_detect(run_id, "run_")) %>%
        dplyr::pull(sample_id)

    sql_samples_df %>%
        dplyr::filter(!sample_id %in% sql_libs_df) %>%
        dplyr::mutate(library_id = stringr::str_replace(sample_id, "S", "L"), .before = 1) %>%
        dplyr::mutate(
            library_id = stringr::str_c(library_id, "_0"),
            run_id = glue::glue("run_{stringi::stri_rand_strings(1, 3, pattern = '[A-Z]')}"),
            s5barcode = NA,
            n7barcode = NA,
            design_date = Sys.Date()
        ) %>%
        dplyr::arrange(submit_date)
}