[FEAT] - viz box new version

UCLouvain-CBIO · Jul 19, 2024 · fe12758 · fe12758
1 parent 3f6898e
commit fe12758
Show file tree

Hide file tree

Showing 5 changed files with 41 additions and 59 deletions.
diff --git a/NAMESPACE b/NAMESPACE
@@ -20,6 +20,7 @@ importFrom(SummarizedExperiment,assay)
 importFrom(SummarizedExperiment,colData)
 importFrom(SummarizedExperiment,rowData)
 importFrom(ggplot2,aes)
+importFrom(ggplot2,geom_boxplot)
 importFrom(ggplot2,geom_violin)
 importFrom(ggplot2,ggplot)
 importFrom(htmltools,HTML)

diff --git a/R/interface_module_log_transform_tab.R b/R/interface_module_log_transform_tab.R
@@ -35,10 +35,10 @@ interface_module_log_transform_tab <- function(id) {
             collapsible = FALSE,
             fluidRow(
                 box(
-                    title = "Summary Plot",
+                    title = "",
                     status = "primary",
-                    width = 10,
-                    solidHeader = TRUE,
+                    width = 9,
+                    solidHeader = FALSE,
                     collapsible = TRUE,
                     withSpinner(plotlyOutput(outputId = NS(id, "boxplot")),
                         type = 6,
@@ -48,7 +48,7 @@ interface_module_log_transform_tab <- function(id) {
                 box(
                     title = "Settings",
                     status = "primary",
-                    width = 2,
+                    width = 3,
                     solidHeader = TRUE,
                     collapsible = TRUE,
                     selectInput(
@@ -64,6 +64,7 @@ interface_module_log_transform_tab <- function(id) {
                         min = 0,
                         step = 1
                     ),
+                    br(),
                     h4("Plot Settings"),
                     selectInput(
                         inputId = NS(id, "sample_col"),

diff --git a/R/interface_module_normalisation_tab.R b/R/interface_module_normalisation_tab.R
@@ -35,18 +35,18 @@ interface_module_normalisation_tab <- function(id) {
             collapsible = FALSE,
             fluidRow(
                 box(
-                    title = "Post Distribution",
+                    title = "",
                     status = "primary",
                     width = 9,
-                    solidHeader = TRUE,
+                    solidHeader = FALSE,
                     collapsible = TRUE,
                     withSpinner(plotlyOutput(outputId = NS(id, "density_plot")),
                         type = 6,
                         color = "#3c8dbc"
                     )
                 ),
                 box(
-                    title = "Normalisation Settings",
+                    title = "Settings",
                     status = "primary",
                     width = 3,
                     solidHeader = TRUE,
@@ -68,7 +68,8 @@ interface_module_normalisation_tab <- function(id) {
                         ),
                         selected = "center.median"
                     ),
-                    h2("Plot options"),
+                    br(),
+                    h4("Plot options"),
                     selectInput(
                         inputId = NS(id, "color"),
                         label = "Color by",

diff --git a/R/server_module_viz_box.R b/R/server_module_viz_box.R
@@ -14,9 +14,10 @@
 server_module_viz_box <- function(id, assays_to_process) {
     moduleServer(id, function(input, output, session) {
         unique_features <- reactive({
-            assays_to_process()
+            req(assays_to_process())
+            req(input$feature_type_column)
             features_list <- lapply(seq_along(assays_to_process()), function(i) {
-                rownames(assay(assays_to_process()[[i]]))
+                rowData(assays_to_process()[[i]])[, input$feature_type_column]
             })
             features_vector <- unlist(features_list)
             unique(features_vector)
@@ -39,51 +40,30 @@ server_module_viz_box <- function(id, assays_to_process) {
             )
         })
 
+        observe({
+            req(assays_to_process())
+            updateSelectInput(session,
+                "feature_type_column",
+                choices = colnames(rowData(assays_to_process()[[1]]))
+            )
+        })
+
         feature_summary_df <- reactive({
             req(assays_to_process())
             req(input$feature)
-            res_df <- data.frame(
-                "sample_type" = character(),
-                "intensity" = numeric()
+            req(input$sample_type_column)
+            req(input$feature_type_column)
+
+            summarize_assays_to_df(
+            qfeatures = assays_to_process(),
+            sample_column = input$sample_type_column,
+            feature_column = input$feature_type_column
             )
-            for (i in names(assays_to_process())) {
-                tryCatch(
-                    {
-                        sub_assay <- getWithColData(assays_to_process(), i)
-                        sub_assay_data <- assay(sub_assay)
-                        if (input$scale) {
-                            sub_assay_data <- scale(sub_assay_data)
-                        }
-                        sub_assay_df <- data.frame(
-                            "sample_type" = colData(sub_assay)[, input$sample_type_column],
-                            "intensity" = sub_assay_data[input$feature, ]
-                        )
-                        res_df <- rbind(res_df, sub_assay_df)
-                    },
-                    error = function(e) {
-                        NULL
-                    }
-                )
-            }
-            res_df
         })
 
-        output$plot <- renderPlotly({
+        output$plot <- renderPlotly({ # Maybe a problem since a lot of line are NAs
             req(feature_summary_df())
-            plot_ly(feature_summary_df(),
-                y = ~intensity,
-                x = ~sample_type,
-                type = "box",
-                boxpoints = "all",
-                color = ~sample_type
-            ) %>%
-                layout(
-                    xaxis = list(
-                        title = "Sample Type",
-                        showticklabels = FALSE
-                    ),
-                    yaxis = list(title = "Intensity")
-                )
+            unique_feature_boxplot(feature_summary_df(), input$feature)
         })
     })
 }
diff --git a/R/utils_global.R b/R/utils_global.R
@@ -575,17 +575,14 @@ summarize_assays_to_df <- function(qfeatures, sample_column, feature_column = NU
 
         assayData <- pivot_longer(assayData, everything(), names_to = "sample", values_to = "intensity")
         assayData$PSM <- rownames(assayData)
-        print(head(assayData))
 
         matched_indices <- match(assayData$sample, rownames(colData(qfeatures)))
         length(matched_indices)
         assayData$sample_type <- colData(qfeatures)[matched_indices, sample_column]
 
-        # assay_df$sample_type <- lapply(assay_df$sample, function(x) {
-        #     colData(qfeatures)[x, sample_column]
-        # })
         if (!is.null(feature_column)) {
-            assayData$feature_type <- rowData(qfeatures[[assayName]])[assayData$PSM, feature_column]
+            matched_indices <- match(assayData$PSM, rownames(rowData(qfeatures[[assayName]])))
+            assayData$feature_type <- rowData(qfeatures[[assayName]])[matched_indices, feature_column]
         }
         combined_df <- rbind(combined_df, assayData)
     }
@@ -623,15 +620,17 @@ features_boxplot <- function(assays_df) {
 #'
 #' @return a plot
 #'
-#' @rdname INTERNAL_feature_boxplot
+#' @rdname INTERNAL_unique_feature_boxplot
 #' @keywords internal
 #' @importFrom plotly ggplotly
-#' @importFrom ggplot2 ggplot aes geom_violin
+#' @importFrom ggplot2 ggplot aes geom_boxplot
 #'
 
-feature_boxplot <- function(assays_df, feature) {
-    plot <- ggplot(assays_df[assays_df$PSM == feature, ], aes(x = sample_type, y = intensity, colour = sample_type)) +
-        geom_violin()
+unique_feature_boxplot <- function(assays_df, feature) {
+    print(head(assays_df))
+    print(feature)
+    plot <- ggplot(assays_df[assays_df$feature_type == feature, , drop = FALSE], aes(x = sample_type, y = intensity, colour = sample_type)) +
+        geom_boxplot()
 
-    ggplotly(plot)
+    suppressWarnings(ggplotly(plot))
 }