RebelAnalysis: Luminex Analysis App

#' Analysis UI Function
#'
#' @description A shiny Module.
#'
#' @param id,input,output,session Internal parameters for {shiny}.
#'
#' @noRd
#'
#' @importFrom shiny NS tagList
#' @importFrom waiter autoWaiter
mod_Analysis_ui <- function(id){
  ns <- NS(id)
  tagList(
    waiter::autoWaiter(color = "#DDD"),
    fluidRow(
      column(
        width = 3,
        shinydashboardPlus::box(
          title = "Input Settings",
          solidHeader = TRUE,
          status = "primary",
          width = 12,
          collapsible = TRUE,
          fileInput(
            inputId = ns("in_luminex_file"),
            label = "Upload data",
            width = "100%",
            accept = c(
              "application/vnd.ms-excel",
              "application/vnd.openxmlformats-officedocument.spreadsheetml.sheet"
            )
          ),
          textInput(
            inputId = ns("in_filename"),
            label = "Project Name",
            value = "My Analysis",
            width = "100%",
            placeholder = "Type a project name..."
          ),
          checkboxInput(
            inputId = ns("log_scales"),
            value = TRUE,
            label = "Log-transform the Y-axis of the plots"
          ),
          downloadButton(
            outputId = ns("out_luminex_report"),
            label = "Download Report",
            style = "width:100%; margin:0 auto;"
          ),
          downloadButton(
            outputId = ns("out_luminex_rawdata"),
            label = "Download Summary",
            style = "width:100%; margin:0 auto;"
          )
        )
      ),
      column(
        width = 9,
        shinydashboardPlus::box(
          title = "Comparisons",
          solidHeader = TRUE,
          status = "primary",
          width = 12,
          collapsible = TRUE,
          shinydashboard::tabBox(
            width = NULL,
            height = "100%",
            tabPanel(
              "Standards",
              fluidRow(
                column(
                  width = 3,
                  selectInput(
                    inputId = ns("in_select_standards"),
                    label = "Select Standards",
                    choices = NULL,
                    selected = NULL,
                    multiple = TRUE,
                    selectize = TRUE,
                    width = "100%"
                  ),
                  selectInput(
                    inputId = ns("in_select_cytokines_forstandards"),
                    label = "Select Cytokines",
                    choices = NULL,
                    selected = NULL,
                    multiple = TRUE,
                    selectize = TRUE,
                    width = "100%"
                  )
                ),
                column(
                  width = 9,
                  plotOutput(ns("out_graph_std")),
                  plotOutput(ns("out_graph_cv_std")),
                  htmlOutput(ns("out_summary_std"), style = "overflow-y: scroll; height:400px"),
                )
              )
            ),
            tabPanel(
              "Analysis",
              fluidRow(
                column(
                  width = 3,
                  selectInput(
                    inputId = ns("in_select_samples"),
                    label = "Select Sample",
                    choices = NULL,
                    selected = NULL,
                    multiple = TRUE,
                    selectize = TRUE,
                    width = "100%"
                  ),
                  selectInput(
                    inputId = ns("in_select_days"),
                    label = "Select Day",
                    choices = NULL,
                    selected = NULL,
                    multiple = TRUE,
                    selectize = TRUE,
                    width = "100%"
                  ),
                  selectInput(
                    inputId = ns("in_select_dilutions"),
                    label = "Select Dilutions",
                    choices = NULL,
                    selected = NULL,
                    multiple = TRUE,
                    selectize = TRUE,
                    width = "100%"
                  ),
                  selectInput(
                    inputId = ns("in_select_cytokines"),
                    label = "Select Cytokines",
                    choices = NULL,
                    selected = NULL,
                    multiple = TRUE,
                    selectize = TRUE,
                    width = "100%"
                  )
                ),
                column(
                  width = 9,
                  shinydashboard::tabBox(
                    width = NULL,
                    height = "100%",
                    tabPanel(
                      "Values",
                      fluidRow(
                        downloadButton(ns("out_filtered_download"), label = "Download Filtered Data Summary"),
                        plotOutput(ns("out_graph_data")),
                        htmlOutput(ns("out_summary_data"))
                      )
                    ),
                    tabPanel(
                      "Dilutions",
                      fluidRow(
                        plotOutput(ns("out_graph_dilution")),
                        htmlOutput(ns("out_summary_dilution"))
                      )
                    ),
                    tabPanel(
                      "Timepoints",
                      plotOutput(ns("out_graph_timepoint")),
                      htmlOutput(ns("out_summary_timepoint"))
                    ),
                    tabPanel(
                      "Variations",
                      fluidRow(
                        column(
                          width = 12,
                          plotOutput(ns("out_graph_var"), height = "500px"),
                          htmlOutput(ns("out_summary_var"), style = "overflow-y: scroll; height:400px"),
                        )
                      )
                    ),
                    tabPanel(
                      "Correlations",
                      fluidRow(
                        column(
                          width = 12,
                          plotOutput(ns("out_graph_cor"), height = "500px"),
                        )
                      )
                    ),
                    tabPanel(
                      "PCA",
                      fluidRow(
                        column(
                          width = 12,
                          tags$p(
                            tags$b("Warning:"),
                            "Get help before interpreting these plots.",
                            "To begin with, make sure you use all the data you have unless you have a good reason not to."
                          ),
                          plotOutput(ns("out_graph_pca"), height = "500px"),
                          plotOutput(ns("out_summary_pca"), height = "500px"),
                          plotOutput(ns("out_scree_pca"), height = "500px")
                        )
                      )
                    )
                  )
                )
              )
            )
          )
        )
      )
    )
  )
}

#' Analysis Server Functions
#'
#' @import tidyr dplyr ggplot2 stringr ggplot2 forcats factoextra openxlsx magrittr
#' @importFrom writexl write_xlsx
#' @importFrom robustbase lmrob
#' @importFrom ggcorrplot ggcorrplot
#' @importFrom Cairo CairoPNG
#'
#' @noRd
mod_Analysis_server <- function(id){
  moduleServer( id, function(input, output, session){
    ns <- session$ns
    some_delay <- 400

    shiny::addResourcePath("tmp", tempdir())  # make a temp location for the filtered data png file
    p1 <- tempfile(fileext = ".png")          # filtered plot file

    # These hold standards and data
    r_luminex_std_raw <- reactiveVal(value = NULL)
    r_luminex_data_raw <- reactiveVal(value = NULL)
    r_luminex_summary_plot <- reactiveVal(value = NULL)

    # Reads input file
    observeEvent(input$in_luminex_file, {

      luminex_data <- NULL

      try({
        luminex_data <- readxl::read_excel(input$in_luminex_file$datapath, sheet = 1, skip = 352, col_names = TRUE, na = c("", "NaN", "NA"), n_max = 97)
        cat("\nData Dimensions: ", dim(luminex_data), "\n")
      }, silent = TRUE)

      if (is.null(luminex_data)) {

        r_luminex_data_raw(NULL)
        r_luminex_std_raw(NULL)

        shinyalert::shinyalert(
          title = "Error [001]",
          text = "Error reading data file, make sure the values are the raw exported data from the instrument, check that the data is on sheet 1, and that it starts at line 354, with headers on line 353, and 96 entries max")
      } else {
        if (mean(dim(luminex_data) == c(96, 27)) != 1) {

          r_luminex_data_raw(NULL)
          r_luminex_std_raw(NULL)

          shinyalert::shinyalert(
            title = "Error [002]",
            text =  "Data dimensions check failed."
          )
        } else {

          luminex_data <- luminex_data %>%
            mutate(across(3:27, ~ as.character(.x))) %>%
            pivot_longer(cols = 3:27, names_to = "Cytokine", values_to = "Value") %>%
            mutate(
              Location = str_extract(Location, "[0-9]+") %>% as.factor(),
              Valid = ifelse(str_detect(Value, "^<"), "LLOQ", ifelse(str_detect(Value, "^>"), "ULOQ", "OK")),
              Value = str_extract(Value, "[0-9]+(\\.[0-9]+)?") %>% as.numeric() %>% round(., digits = 2)
            )

          r_luminex_std_raw(
            luminex_data %>%
              filter(str_detect(Sample, "(^Standard[0-9]{1}$)|(^Background[0-9]{0,1}$)"), Cytokine != "Total Events") %>%
              mutate(Sample = factor(Sample))
          )

          r_luminex_data_raw(
            luminex_data %>%
              filter(!str_detect(Sample, "(^Standard[0-9]{1}$)|(^Background[0-9]{0,1}$)"), Cytokine != "Total Events") %>%
              mutate(
                Dilution = str_extract(Sample, "(?<=(1:))[0-9]+") %>% as.numeric() %>% factor(),
                Day = str_extract(Sample, "(?<=( D))[0-9]+") %>% as.numeric() %>% factor(),
                Name = str_extract(Sample, "\\w+"),
                Sample_day = paste0(Name, " Day ", Day)
              )
          )

          xx_samples <- unique(r_luminex_data_raw()$Name) %>% sort()
          xx_cytokines <- unique(r_luminex_data_raw()$Cytokine) %>% sort()
          xx_dilutions <- unique(r_luminex_data_raw()$Dilution) %>% sort()
          xx_days <- unique(r_luminex_data_raw()$Day) %>% sort()

          xx_cytokines_forstandards <- unique(r_luminex_std_raw()$Cytokine) %>% sort()
          xx_standards <- unique(r_luminex_std_raw()$Sample) %>% sort()

          updateSelectInput(session = session, inputId = "in_select_samples", choices = xx_samples)
          updateSelectInput(session = session, inputId = "in_select_cytokines", choices = xx_cytokines, selected = xx_cytokines)
          updateSelectInput(session = session, inputId = "in_select_dilutions", choices = xx_dilutions, selected = xx_dilutions)
          updateSelectInput(session = session, inputId = "in_select_days", choices = xx_days, selected = xx_days)

          updateSelectInput(session = session, inputId = "in_select_standards", choices = xx_standards, selected = xx_standards)
          updateSelectInput(session = session, inputId = "in_select_cytokines_forstandards", choices = xx_cytokines_forstandards, selected = xx_cytokines_forstandards)
        }
      }
    })

    # debounce sample/cytokine selection
    selected_samples <- reactive({
      input$in_select_samples
    })
    selected_days <- reactive({
      input$in_select_days
    })
    selected_dilutions <- reactive({
      input$in_select_dilutions
    })
    selected_cytokines <- reactive({
      input$in_select_cytokines
    })
    selected_standards <- reactive({
      input$in_select_standards
    })
    selected_cytokines_forstandards <- reactive({
      input$in_select_cytokines_forstandards
    })

    d_samples <- debounce(selected_samples, some_delay)
    d_days <- debounce(selected_days, some_delay)
    d_dilutions <- debounce(selected_dilutions, some_delay)
    d_cytokines <- debounce(selected_cytokines, some_delay)
    d_standards <- debounce(selected_standards, some_delay)
    d_cytokines_forstandards <- debounce(selected_cytokines_forstandards, some_delay)

    # Reactive filtering
    r_luminex_std <- reactive({
      req(r_luminex_std_raw())

      r_luminex_std_raw() %>%
        filter(
          Sample %in% d_standards(),
          Cytokine %in% d_cytokines_forstandards()
        )
    })

    r_luminex_data <- reactive({
      req(r_luminex_data_raw())

      r_luminex_data_raw() %>%
        filter(
          Name %in% d_samples(),
          Cytokine %in% d_cytokines(),
          Day %in% d_days(),
          Dilution %in% d_dilutions()
        )
    })

    output$out_summary_std <- renderText({
      req(r_luminex_std(), d_cytokines_forstandards(), d_standards())

      r_luminex_std() %>%
        process_std() %>%
        render_std_table()

    }) %>% bindCache(r_luminex_std())

    output$out_summary_data <- renderText({
      req(r_luminex_data(), d_samples(), d_days(), d_dilutions(), d_cytokines())

      r_luminex_data() %>%
        process_data() %>%
        render_data_table()

    }) %>% bindCache(r_luminex_data())

    output$out_graph_std <- renderPlot({
      req(r_luminex_std(), d_cytokines_forstandards(), d_standards())

      p <- r_luminex_std() %>%
        render_standards_graph()

      if (input$log_scales) {
        p <- p + scale_y_log10(labels = function(x) format(x, scientific = FALSE))
        return(p)
      } else {
        p <- p + scale_y_continuous(labels = function(x) format(x, scientific = FALSE))
        return(p)
      }

    }) %>% bindCache(r_luminex_std(), input$log_scales)

    output$out_graph_cv_std <- renderPlot({
      req(r_luminex_std_raw())

      r_luminex_std_raw() %>%
        process_std() %>%
        render_standards_cv_graph()

    }) %>% bindCache(r_luminex_std_raw())

    output$out_graph_data <- renderPlot({
      req(r_luminex_data(), d_samples(), d_days(), d_dilutions(), d_cytokines())

      p <- r_luminex_data() %>%
        render_samples_graph()

      if (input$log_scales) {

        p <- p + scale_y_log10(labels = function(x) format(x, scientific = FALSE))
        r_luminex_summary_plot(p)
        return(p)

      } else {

        p <- p + scale_y_continuous(labels = function(x) format(x, scientific = FALSE))
        r_luminex_summary_plot(p)
        return(p)
      }

    }) %>% bindCache(r_luminex_data(), input$log_scales)

    output$out_graph_dilution <- renderPlot({
      req(r_luminex_data(), d_samples(), d_days(), d_dilutions(), d_cytokines())

      p <- r_luminex_data() %>%
        render_dilutions_graph()

      if (input$log_scales) {
        p <- p + scale_y_log10(labels = function(x) format(x, scientific = FALSE))
        return(p)
      } else {
        p <- p + scale_y_continuous(labels = function(x) format(x, scientific = FALSE))
        return(p)
      }
    }) %>% bindCache(r_luminex_data(), input$log_scales)

    output$out_graph_timepoint <- renderPlot({
      req(r_luminex_data(), d_samples(), d_days(), d_dilutions(), d_cytokines())

      p <- r_luminex_data() %>%
        render_timepoint_graph()

      if (input$log_scales) {
        p <- p + scale_y_log10(labels = function(x) format(x, scientific = FALSE))
        return(p)
      } else {
        p <- p + scale_y_continuous(labels = function(x) format(x, scientific = FALSE))
        return(p)
      }

    }) %>% bindCache(r_luminex_data(), input$log_scales)

    output$out_summary_var <- renderText({
      req(r_luminex_data(), d_samples(), d_days(), d_dilutions(), d_cytokines())

      r_luminex_data() %>%
        calculate_var_table_data() %>%
        render_var_table()

    }) %>% bindCache(r_luminex_data())

    output$out_graph_var <- renderPlot({
      req(r_luminex_data(), d_samples(), d_days(), d_dilutions(), d_cytokines())

      p <- r_luminex_data() %>%
        render_var_graph()

      return(p)

    }) %>% bindCache(r_luminex_data())

    output$out_graph_cor <- renderPlot({
      req(r_luminex_data(), d_samples(), d_days(), d_dilutions(), d_cytokines())

      p <- r_luminex_data() %>%
        render_cor_graph()

      return(p)

    }) %>% bindCache(r_luminex_data())

    # PCA Analysis object/data
    xx_data_pca <- reactive({
      req(r_luminex_data(), d_samples(), d_days(), d_dilutions(), d_cytokines())

      pca_data <- r_luminex_data() %>%
        calculate_pca_data()

    }) %>% bindCache(r_luminex_data())

    output$out_summary_pca <- renderPlot({
      req(r_luminex_data(), d_samples(), d_days(), d_dilutions(), d_cytokines())

      xx_data_pca() %>%
        render_pca_summary_graph()

    }) %>% bindCache(r_luminex_data())

    output$out_graph_pca <- renderPlot({
      req(r_luminex_data(), d_samples(), d_days(), d_dilutions(), d_cytokines())

      xx_data_pca() %>%
        render_pca_biplot_graph()

    }) %>% bindCache(r_luminex_data())

    output$out_scree_pca <- renderPlot({
      req(r_luminex_data(), d_samples(), d_days(), d_dilutions(), d_cytokines())

      xx_data_pca() %>%
        render_pca_scree_graph()

    }) %>% bindCache(r_luminex_data())

    # Download filtered data (Excel summary table + graph)
    output$out_filtered_download <- downloadHandler(
      filename = function() {
        paste0(format(Sys.time(), "%Y-%m-%d_%H-%M-%S"), " - Filtered - ", input$in_filename, ".xlsx")
      },
      content = function(file) {
        my_export <- createWorkbook()
        addWorksheet(my_export, sheetName = "Filtered_Data", gridLines = FALSE)
        addWorksheet(my_export, sheetName = "Data_Graph", gridLines = FALSE)
        freezePane(my_export, sheet = 1, firstRow = TRUE)
        writeDataTable(my_export, sheet = 1,
                                 x = r_luminex_data() %>%
                                   process_data() %>%
                                   mutate(
                                     Value = round(Value, 2),
                                     Dilution = as.numeric(as.character(Dilution)),
                                     Day = as.numeric(as.character(Day)),
                                     Average = round(Average, 1),
                                     CV = round(as.numeric(CV), 2)
                                   ))

        CairoPNG(filename = p1, width = 1280, height = 720, dpi = 150)
        plot(r_luminex_summary_plot())
        dev.off()

        insertImage(
          my_export, sheet = 2, file = p1, startRow = 2,
          units = "px", width = 1280/.64, height = 720/.64, dpi = 150
        ) # not sure why it gets scaled to 64% so here's a "quick fix"

        return(saveWorkbook(my_export, file = file))
      }
    )

    # Stores the data that will get reported
    r_download_data <- reactive({
      list(
        standards = r_luminex_std_raw(),
        data = r_luminex_data_raw()
      )
    })

    # Build and download report
    output$out_luminex_report <- downloadHandler(
      filename = function() {
        paste0("REBEL_Analysis_Report_", format(Sys.time(), "%Y-%m-%d_%H-%M-%S"), " - ", input$in_filename, ".html")
      },
      content = function(file) {
        shiny::withProgress(
          message = paste0("Downloading Report"),
          value = 0,
          {
            params <- list(
              name = paste0("Report for: ", input$in_filename),
              all_data = r_download_data()
            )

            shiny::incProgress(.05)

            rmarkdown::render(
              file.path(system.file(package = "LuminexAnalysis"), "app", "www", "luminex_report.Rmd"),
              output_file = file,
              params = params,
              envir = new.env()
            )

            shiny::incProgress(.05)

          }
        )
      }
    )

    # Download Raw Data
    output$out_luminex_rawdata <- downloadHandler(
      filename = function() {
        paste0("REBEL_Analysis_Data_", format(Sys.time(), "%Y-%m-%d_%H-%M-%S"), " - ", input$in_filename, ".xlsx")
      },
      content = function(file) {
        return(
          writexl::write_xlsx(
            x = r_download_data() %>%
              process_for_download() %>%
              set_names(c("RAW Standards", "Standards", "RAW Data", "Data")),
            path = file
          )
        )
      }
    )

  })
}