added shinyApp to explore quality metrics

sc_workflow/sc_apps/metrics_explorer

+#!/usr/bin/env bash
+
+export SCRIPT_DIRECTORY="$(dirname "$0")/"
+
+/usr/local/bin/Rscript -<<"EOF" ${SCRIPT_DIRECTORY}
+
+args = commandArgs(trailingOnly = TRUE)
+
+# LOAD packages --------------------------------------------------------------------------------------------------------
+devtools::source_url("https://git.mpi-cbg.de/bioinfo/datautils/raw/v1.45/R/core_commons.R")
+load_pack(destiny)
+load_pack(plotly)
+load_pack(shiny)
+load_pack(data.table)
+load_pack(rlist)
+
+
+# Determine data directory from execution context  ---------------------------------------------------------------------
+
+dataPath= args[1]
+#dataPath = "."
+
+#-----------------------------------------------------------------------------------------------------------------------
+
+# load all required data
+all_files <- list.files(dataPath)
+files_req <- c("dm.rds", "pca.rds", "cell_infos.txt")
+
+if (any(!files_req %in% all_files)) { stop("ATTENTION: please make sure dm.rds, pca.rds and cell_infos.txt exist in your working directory") }
+
+dm <- readRDS("dm.rds")
+pca <- readRDS("pca.rds")
+infos <- if(file.exists("scater_quality_metrics.txt")) {
+        read_tsv("scater_quality_metrics.txt")
+    } else {
+        read_tsv("cell_infos.txt")
+    }
+
+# extract information on numeric values for the violin plots
+infos_num <- infos %>% column_to_rownames("cell_id") %>% select_if(is.numeric) %>% mutate(cell_id = rownames(.)) %>%
+    push_left("cell_id") %>% gather(feature, value, -cell_id) %>% mutate(type = "numeric") %>% na.omit()
+
+# extract information on the non-numeric values for the subsetting
+infos_char <- infos %>% column_to_rownames("cell_id") %>% select_if(funs(!is.numeric(.))) %>% mutate(cell_id = rownames(.)) %>%
+    push_left("cell_id") %>% gather(feature, value, -cell_id) %>% mutate(type = "non_numeric") %>% na.omit()
+
+infos <- rbind(infos_num, infos_char)
+
+
+# select metrics suitable for subsetting and prepare radioButtons choices
+info_groups <- infos %>% filter(type == "non_numeric") %>% select(-cell_id) %>% group_by(feature) %>% unique() %>% summarize(count = n()) %>% filter(between(count, 2,5)) %$% feature
+radio_choices <- lapply(setNames(info_groups, info_groups), function(x) {
+    which(info_groups == x)
+})
+radio_choices <- list.append(radio_choices, "no subsetting" = length(radio_choices) + 1)
+
+select_choices <- infos %>% filter(type == "numeric")
+
+
+# combine dm data with all metrics
+dm %<>% as.data.frame() %>% mutate(cell_id = rownames(.)) %>% select(cell_id, DC1:DC10) %>% right_join(infos, by = "cell_id")
+
+# combine PCA data with all metrics
+pca %<>% as.data.frame() %>% mutate(cell_id = rownames(.)) %>% select(cell_id, PC1:PC10) %>% right_join(infos, by = "cell_id")
+
+
+
+app <- shinyApp(
+
+    ui <- navbarPage(title = "Explore Quality Metrics", id = "tabs",
+
+        tabPanel(title = "Violin plot",
+         sidebarPanel(width = 3,
+                selectInput(inputId = "choosen_metric", label = "Choose metrics",
+                        choices = unique(select_choices$feature), selected = c("nGene", "nUMI", "percent.mito"),
+                    multiple = TRUE, selectize=TRUE),
+                br(),
+                br(),
+                radioButtons("choosen_subsetting", label = "Choose data subsetting",
+                    choices = radio_choices,
+                    selected = length(radio_choices)),
+                br(),
+                tableOutput(outputId = "subset_summary")
+            ),
+            mainPanel("",
+                fixedRow(
+                    column(12, HTML(paste('<br/>')),
+                        plotOutput(outputId = "violin_plot", height = "auto")
+                    )
+                )
+            )
+        ),
+       tabPanel(title = "Diffusion map",
+           sidebarPanel(width = 3,
+               selectInput(inputId = "choosen_metric_dm", label = "Choose metrics", choices = unique(infos$feature), multiple = FALSE, selected = "nGene", selectize=TRUE),
+               br(),
+               br()
+           ),
+       mainPanel("",
+               fixedRow(
+                   column(12, HTML(paste('<br/>')),
+                       plotlyOutput(outputId = "dm")
+                   )
+               )
+           )
+       ),
+        tabPanel(title = "PCA",
+           sidebarPanel(width = 3,
+                   selectInput(inputId = "choosen_metric_pca", label = "Choose metrics", choices = unique(infos$feature), multiple = FALSE, selected = "nGene", selectize=TRUE),
+                   br(),
+                   br()
+               ),
+           mainPanel("",
+                   fixedRow(
+                       column(12, HTML(paste('<br/>')),
+                           plotlyOutput(outputId = "pca")
+                       )
+                   )
+               )
+       )
+    ),
+
+    server <- function(input, output, session) {
+
+
+        ## VIOLIN PLOTS
+        output$violin_plot <- renderPlot({
+            infos_features <- infos %>% filter(feature %in% input$choosen_metric & type == "numeric")
+#            infos_features <- infos %>% filter(feature %in% c("nUMI", "nGene"))
+
+            if (input$choosen_subsetting == length(radio_choices)) {
+                vp <- infos_features %>% ggplot(aes(feature, as.numeric(value))) + geom_violin() +
+                    xlab("") + facet_wrap(~feature, scale = "free", ncol = 2)
+            } else {
+                subset_var <- radio_choices[as.numeric(input$choosen_subsetting)] %>% names()
+                infos_subset <- infos %>% filter(feature == subset_var) %>% select(cell_id, value)
+#                infos_subset <- infos %>% filter(feature == "phase") %>% select(cell_id, value)
+                colnames(infos_subset) <- c("cell_id", "subsets")
+                infos_features <- left_join(infos_features, infos_subset, by = "cell_id")
+
+#                infos_features$subsets <- factor(infos_features$subsets,levels = unique(infos_features$subsets))
+                vp <- infos_features %>% ggplot(aes(feature, as.numeric(value), fill = subsets)) + geom_violin() +
+                    xlab("") + facet_wrap(~feature, scale = "free", ncol = 2)
+            }
+            vp + theme(strip.text.x = element_text(size = 20), axis.title.x=element_blank(),
+                axis.text.x=element_blank(),
+                axis.ticks.x=element_blank(),
+                panel.spacing = unit(2, "lines"),
+                axis.text.y=element_text(size = 12),
+                legend.text=element_text(size=14),
+                legend.title=element_blank()) +
+                ylab("")
+
+        }, height = function(){400*ceiling(length(input$choosen_metric)/2)})
+
+        output$subset_summary <- renderTable({
+            if (input$choosen_subsetting != length(radio_choices)){
+                subset_var <- radio_choices[as.numeric(input$choosen_subsetting)] %>% names()
+#                subset_var <- radio_choices[as.numeric("2")] %>% names()
+                infos_sum <- infos %>% filter(feature == subset_var) %>% count(value)
+                colnames(infos_sum) <- c(subset_var, "count")
+                infos_sum
+            }
+        })
+
+
+
+        ## DIFFUSION MAP
+        output$dm <- renderPlotly({
+
+            dm_data <- dm %>% filter(feature == input$choosen_metric_dm)
+            # dm_data <- dm %>% filter(feature == "nGene")
+
+
+            if(unique(dm_data$type) == "numeric"){
+                plot_ly(dm_data, x = ~DC1, y = ~DC2, z = ~DC3, color = ~as.numeric(value), size = I(5), type = "scatter3d") %>%
+                layout(autosize = F, width = 1000, height = 1000, margin = list(l = 50, r = 50, b = 50, t = 50, pad = 4))
+            } else {
+                plot_ly(dm_data, x = ~DC1, y = ~DC2, z = ~DC3, color = ~as.factor(value), size = I(5), type = "scatter3d") %>%
+                layout(autosize = F, width = 1000, height = 1000, margin = list(l = 50, r = 50, b = 50, t = 50, pad = 4))
+            }
+        })
+
+
+
+        ## PCA
+        output$pca <- renderPlotly({
+
+            pca_data <- pca %>% filter(feature == input$choosen_metric_pca)
+            # pca_data <- pca %>% filter(feature == "nGene")
+
+
+            if(unique(pca_data$type) == "numeric"){
+                plot_ly(pca_data, x = ~PC1, y = ~PC2, z = ~PC3, color = ~as.numeric(value), size = I(5), type = "scatter3d") %>%
+                layout(autosize = F, width = 1000, height = 1000, margin = list(l = 50, r = 50, b = 50, t = 50, pad = 4))
+            } else {
+                plot_ly(pca_data, x = ~PC1, y = ~PC2, z = ~PC3, color = ~as.factor(value), size = I(5), type = "scatter3d") %>%
+                layout(autosize = F, width = 1000, height = 1000, margin = list(l = 50, r = 50, b = 50, t = 50, pad = 4))
+            }
+        })
+
+    }
+)
+
+#runApp(app, launch.browser=TRUE, port=5357)
+runApp(app, launch.browser=TRUE)
+EOF