[FEAT] - remove QFeatures# pattern in assay's names

UCLouvain-CBIO · Jul 15, 2024 · ada6132 · ada6132
1 parent b593b35
commit ada6132
Show file tree

Hide file tree

Showing 7 changed files with 29 additions and 18 deletions.
diff --git a/R/server_module_box_readQFeatures.R b/R/server_module_box_readQFeatures.R
@@ -62,7 +62,7 @@ box_readqfeatures_server <- function(id, input_table, sample_table) {
             for (i in seq_along(global_rv$qfeatures)) {
                 names(global_rv$qfeatures)[i] <- paste0(
                     names(global_rv$qfeatures)[i],
-                    "_(QFeaturesGUI#0)"
+                    "_(QFeaturesGUI#0)_initial_import"
                 )
             }
             removeModal()

diff --git a/R/server_module_features_filtering_tab.R b/R/server_module_features_filtering_tab.R
@@ -161,7 +161,8 @@ server_module_features_filtering_tab <- function(id, step_number) {
                 add_assays_to_global_rv,
                 component_name = "Add assays to global_rv",
                 processed_qfeatures = processed_assays(),
-                step_number = step_number
+                step_number = step_number,
+                type = "features_filtering"
             )
             removeModal()
         })

diff --git a/R/server_module_qc_metrics.R b/R/server_module_qc_metrics.R
@@ -12,10 +12,17 @@
 server_module_qc_metrics <- function(id, assays_to_process, type) {
     stopifnot(is.reactive(assays_to_process))
     moduleServer(id, function(input, output, session) {
+        assays_choices_vector <- reactive({
+            original_names <- names(assays_to_process())
+            modified_names <- remove_QFeaturesGUI(original_names)
+            choices_vector <- setNames(original_names, modified_names)
+            return(choices_vector)
+        })
         observe({
+            req(assays_choices_vector)
             updateSelectInput(session,
                 "selected_assay",
-                choices = names(assays_to_process())
+                choices = names(assays_choices_vector())
             )
         })
         single_assay <- reactive({
@@ -24,7 +31,8 @@ server_module_qc_metrics <- function(id, assays_to_process, type) {
             # Warning appears here
             # Warning message: 'experiments' dropped; see 'drops()'
             # see with Chris
-            getWithColData(assays_to_process(), input$selected_assay)
+            getWithColData(assays_to_process(),
+                 assays_choices_vector()[input$selected_assay])
         })
 
         server_module_pca_box(

diff --git a/R/server_module_samples_filtering_tab.R b/R/server_module_samples_filtering_tab.R
@@ -159,7 +159,8 @@ server_module_samples_filtering_tab <- function(id, step_number) {
                 add_assays_to_global_rv,
                 component_name = "Add assays to global_rv",
                 processed_qfeatures = processed_assays(),
-                step_number = step_number
+                step_number = step_number,
+                type = "samples_filtering"
             )
             removeModal()
         })

diff --git a/R/server_module_summary_tab.R b/R/server_module_summary_tab.R
@@ -54,7 +54,9 @@ server_module_summary_tab <- function(id) {
 
         output$qfeatures_plot <- renderPlotly({
             if (length(global_rv$qfeatures) > 0) {
-                plot(global_rv$qfeatures,
+                empty_qfeatures <- global_rv$qfeatures[1,]
+                names(empty_qfeatures) <- remove_QFeaturesGUI(names(empty_qfeatures))
+                plot(empty_qfeatures,
                     interactive = TRUE
                 )
             }

diff --git a/R/utils_global.R b/R/utils_global.R
@@ -152,14 +152,13 @@ loading <- function(msg) {
 #' A function that remove the "(QFeaturesGUI#x)" suffix from a string
 #' @param string `str` string to remove the suffix from
 #' @return `str` the string without the suffix
-#' @rdname INTERNAL_remove_scpGUI
+#' @rdname INTERNAL_remove_QFeaturesGUI
 #' @keywords internal
 #'
 #'
-remove_scpGUI <- function(string) {
-    return(gsub("\\_(QFeaturesGUI#[0-9]+\\)", "", string))
+remove_QFeaturesGUI <- function(string) {
+    return(gsub("_\\(QFeaturesGUI#[0-9]+\\)", "", string))
 }
-
 #' PCA Methods Wrapper
 #'
 #' This function performs Principal Component Analysis (PCA) on a SingleCellExperiment object using the specified method.
@@ -296,14 +295,14 @@ pca_plotly <- function(df, pca_result, color_name, show_legend) {
 #' @return (NULL) does not return anything but will add the assays to the global_rv qfeatures object
 #' @importFrom QFeatures addAssayLink
 
-add_assays_to_global_rv <- function(processed_qfeatures, step_number) {
+add_assays_to_global_rv <- function(processed_qfeatures, step_number, type) {
+    print(names(processed_qfeatures))
     for (name in names(processed_qfeatures)) {
-        new_name <- gsub(
-            pattern = paste0("_(QFeaturesGUI#", step_number - 1, ")"),
-            replacement = paste0("_(QFeaturesGUI#", step_number, ")"),
-            x = name,
-            fixed = TRUE
-        )
+        new_name <- paste0(
+            strsplit(name, "_(QFeaturesGUI#", fixed = TRUE)[[1]][[1]],
+            "_(QFeaturesGUI#", step_number, ")",
+            "_", type, "_", step_number)
+
         global_rv$qfeatures[[new_name]] <- processed_qfeatures[[name]]
 
         global_rv$qfeatures <- addAssayLink(

diff --git a/R/utils_import_tab.R b/R/utils_import_tab.R
@@ -14,7 +14,7 @@ qfeatures_to_df <- function(qfeatures) {
         "ncols" = rep.int(0, length(qfeatures))
     )
     for (i in seq_along(qfeatures)) {
-        df[i, "Name"] <- names(qfeatures)[[i]]
+        df[i, "Name"] <- remove_QFeaturesGUI(names(qfeatures)[[i]])
         df[i, "Class"] <- class(qfeatures[[i]])[[1]]
         df[i, "nrows"] <- nrow(qfeatures[[i]])[[1]]
         df[i, "ncols"] <- ncol(qfeatures[[i]])[[1]]