mod_dataset_choice.R

#' dataset_choice UI Function
#'
#' @description A shiny Module.
#'
#' @param id,input,output,session Internal parameters for {shiny}.
#'
#' @noRd
#'
#' @importFrom shiny NS tagList uiOutput
#' @importFrom datamods i18n
#' @importFrom shinyWidgets radioGroupButtons pickerInput actionBttn
#'
mod_dataset_choice_ui <- function(id) {
  ns <- NS(id)
  tagList(
    radioGroupButtons(
      inputId = ns("data_source"),
      label = "",
      choices = c(
        i18n("Integrated dataset"),
        i18n("User Load")
      ),
      selected = i18n("Integrated dataset"),
      justified = TRUE
    ),
    uiOutput(ns("dynamic_ui")),
    div(
      align = "center",
      actionBttn(ns("launch_the_data"), i18n("Show Table"),
        style = "material-flat",
        color = "primary"
      )
    )
    #
  )
}

#' dataset_choice Server Functions
#' @import dplyr
#' @importFrom datamods i18n
#' @noRd
mod_dataset_choice_server <- function(id, r_global) {
  moduleServer(id, function(input, output, session) {
    ns <- session$ns



    output$dynamic_ui <- renderUI({
      req(input$data_source == i18n("Integrated dataset"))
      fluidPage(
        pickerInput(
          ns("dataset"),
          i18n("Dataset Choice"),
          c("Microarray" = "microarray", "RNA-seq" = "rna")
        ),
        uiOutput(ns("espece")),
        conditionalPanel(
          condition = "input.dataset == 'microarray'",
          pickerInput(
            ns("TailleDonnee"),
            i18n("Which analysis version ?"),
            setNames(
              c("all", "P1", "P6", "P9", "P12", "P17"),
              c(i18n("All Samples"), "Patient 1", "Patient 6", "Patient 9", "Patient 12", "Patient 17")
            )
          )
        ,ns=ns
        ),
        uiOutput(ns("batch")),
        pickerInput(
          ns("Tabletype"),
          i18n("Table choice"),
          setNames(
            c("TMM", "topTable"),
            c(i18n("Normalized Expression"), i18n("Differential Expression Table"))
          ),
          selected = "topTable"
        ),
        uiOutput(ns("whichIsCompare")),
        tags$br(),
        textOutput(ns("rendertext")),
        tags$br()
      )
    })

    output$espece <- renderUI({
      req(input$dataset)

      if (input$dataset == "rna") {
        pickerInput(
          ns("espece"),
          label = NULL,
          choices = setNames(
            c("Hs.9606", "Mm.10090"),
            c(paste0(i18n("Human")," (9606)"), paste0(i18n("Mouse")," (10090)"))
          ),
          selected = "Hs.9606"
        )
      } else {
        NULL
      }
    })


    output$batch <- renderUI({
      req(input$TailleDonnee)

      if (input$TailleDonnee == "P12") {
        renderUI({
          pickerInput(ns("batch"),
            label = NULL,
            choices = c(
              "Batch 2" = "2",
              "Batch 3" = "3"
            ), selected = "2"
          )
        })
      } else if (input$TailleDonnee == "P1") {
        renderUI({
          pickerInput(ns("batch"),
            label = NULL,
            choices = c("Batch 3" = "3"), selected = "3"
          )
        })
      } else if (input$TailleDonnee %in% c("P6", "P17", "P9")) {
        renderUI({
          pickerInput(ns("batch"),
            label = NULL,
            choices = c("Batch 2" = "2"), selected = "2"
          )
        })
      } else {
        NULL
      }
    })


    output$whichIsCompare <- renderUI({
      req(input$Tabletype)
      req(input$dataset)

      if (input$Tabletype == "topTable") {
        renderUI({
          pickerInput(ns("whichIsCompare"),
            label = i18n("Which Comparision?"),
            choices = {
              if (input$dataset == "rna") Comparaisons[[input$dataset]] else Comparaisons[[input$dataset]][[input$TailleDonnee]]
            }, selected = "F2S vs F2NT"
          )
        })
      } else {
        NULL
      }
    })




    nameReactive <- reactive({
      req(input$dataset, input$TailleDonnee, input$Tabletype)


      find_the_integrated(
        input$dataset,
        input$TailleDonnee,
        input$batch,
        input$espece,
        input$Tabletype,
        input$whichIsCompare
      )
    })


    nameReactive_metadata <- reactive({
      req(input$dataset, input$Tabletype)


      find_metadata_file(
        input$dataset,
        input$TailleDonnee
      )
    })



    nametab <- debounce(nameReactive, 500)
    namemetatab <- debounce(nameReactive_metadata, 500)

    # Use the debounced reactive expression where needed
    output$rendertext <- renderText({
      nametab()
    })




    TMMtab <- reactive({
      if (input$Tabletype == "topTable") {
        TMM <- paste(sub("\\.topTable.*$|\\.TMM.*$", "", nametab()), "TMM", "counts", sep = ".")
        return(TMM)
      }
    })



    Add_TMM_to_TopTable <- eventReactive(
      {
        input$launch_the_data
      },
      {
        tryCatch({
          Sel <- grep(paste0(paste(SubSelection[[input$whichIsCompare]], collapse = "|"), "|EntrezID"),
                      colnames(get(TMMtab())),
                      value = TRUE)
          newSel <- get(TMMtab()) %>% subset(select = Sel)
          return(newSel)
        }, error = function(e) {
          message(paste(i18n("Error: Object"), TMMtab(), i18n("does not exist in .GlobalEnv")))
          return(NULL) 
        })
      }
    )
    



    thistab <- eventReactive(input$launch_the_data, {
      tab_name <- nametab()

      newTab <- tryCatch(
        {
          get(tab_name, envir = .GlobalEnv)
        },
        error = function(e) {
          message(paste(i18n("Error: Object"), tab_name, i18n("does not exist in .GlobalEnv")))
          return(NULL) # Return NULL if there is an error
        }
      )



      ref <- intersect(colnames(newTab), colnames(GeneIDS))

      newTab
    })

    metadatatab <- eventReactive(input$launch_the_data, {
      tab_name <- namemetatab()

      newTab <- tryCatch(
        {
          get(tab_name, envir = .GlobalEnv)
        },
        error = function(e) {
          message(paste(i18n("Error: Object"), tab_name, i18n("does not exist in .GlobalEnv")))
          return(NULL) # Return NULL if there is an error
        }
      )

      if (is.null(newTab)) {
        return(NULL)
      }


      newTab <- newTab %>%
        filter({
          if (input$dataset == "microarray") {
            if (input$TailleDonnee != "all") {
              Batch == input$batch & Patient == input$TailleDonnee
            } else {
              Batch %in% c(2, 3)
            }
          } else {
            TRUE
          }
        })

      # Step 2: Remove row names
      rownames(newTab) <- NULL

      # Step 3: Set 'ID' column as row names and remove 'ID' column
      rownames(newTab) <- newTab$ID
      newTab <- newTab %>% select(-ID)

      # Step 4: Filter based on 'Tabletype' and 'subSelectTMMchoice'
      newTab %>%
        filter({
          if (input$Tabletype == "topTable") {
            rownames(newTab) %in% grep(paste(SubSelection[[input$whichIsCompare]], collapse = "|"), rownames(newTab), value = TRUE)
          } else if (!is.null(input$subSelectTMMchoice)) {
            rownames(newTab) %in% grep(paste(unlist(SubSelection[c(input$subSelectTMMchoice)]), collapse = "|"), rownames(newTab), value = TRUE)
          } else {
            TRUE
          }
        }) %>%
        mutate(across(where(is.factor), droplevels))
    })

    # observeEvent(input$launch_the_data, {
    #   shinyjs::showElement(id = "main-1")
    # })


    observe({
      r_global$loaded_table <- thistab()
    })

    observe({
      r_global$loaded_metatable <- metadatatab()
    })

    observe({
      r_global$linked_tmm <- Add_TMM_to_TopTable()
    })
    # observe({
    #  print(Add_TMM_to_TopTable())
    # })
  })
}