Introduce tab for Quality Control

Author: RiboRings

DESCRIPTION

@@ -1,5 +1,5 @@
 Package: miaDash
-Version: 1.1.2
+Version: 1.1.3
 Authors@R: 
     c(person(given = "Giulio", family = "Benedetti", role = c("aut", "cre"),
            email = "giulio.benedetti@utu.fi",
@@ -10,7 +10,7 @@ Authors@R:
     person(given = "Leo", family = "Lahti", role = c("aut"),
              email = "leo.lahti@iki.fi",
              comment = c(ORCID = "0000-0001-5537-637X")))
-Title: Shiny app for the interactive analysis and exploration of microbiome data
+Title: Dashboard for the interactive analysis and exploration of microbiome data
 Description:
     miaDash provides a Graphical User Interface for the exploration of
     microbiome data. This way, no knowledge of programming is required to
@@ -30,6 +30,7 @@ Imports:
     mia,
     rintrojs,
     scater,
+    scuttle,
     shinydashboard,
     shinyjs,
     S4Vectors,

NAMESPACE

@@ -26,6 +26,9 @@ importFrom(iSEEtree,RowGraphPlot)
 importFrom(iSEEtree,RowTreePlot)
 importFrom(iSEEtree,ScreePlot)
 importFrom(mia,addAlpha)
+importFrom(mia,addHierarchyTree)
+importFrom(mia,addPrevalence)
+importFrom(mia,addPrevalentAbundance)
 importFrom(mia,agglomerateByRank)
 importFrom(mia,getDissimilarity)
 importFrom(mia,importBIOM)
@@ -42,6 +45,7 @@ importFrom(mia,transformAssay)
 importFrom(rintrojs,introjs)
 importFrom(scater,runMDS)
 importFrom(scater,runPCA)
+importFrom(scuttle,addPerCellQC)
 importFrom(shinydashboard,box)
 importFrom(shinydashboard,dashboardBody)
 importFrom(shinydashboard,dashboardHeader)

NEWS

@@ -1,3 +1,6 @@
+Changes in version 1.1.3
+* Introduced tab for Quality Control
+
 Changes in version 1.1.2
 * Added importers for HUMAnN, QIIME2 and Mothur
 * Improved biom importer

R/constants.R

@@ -50,4 +50,9 @@ NULL
 
 #' @rdname constants
 .betaMethods <- c("MDS", "NMDS", "PCA", "RDA")
-#"TSNE", "UMAP")
+#"TSNE", "UMAP")
+
+#' @rdname constants
+.qualityMetrics <- list("Library size" = "PerCellQC",
+    "Prevalence" = "Prevalence", "Prevalent abundance" = "PrevalentAbundance",
+    "Hierarchy tree" = "HierarchyTree")

R/landing_page.R

@@ -180,11 +180,17 @@
                         header = tagList(
                             br(), selectInput(inputId = "estimate.assay",
                                 label = "Assay:", choices = NULL)),
+                        
+                        tabPanel(title = "Quality", value = "quality",
+                            
+                            checkboxGroupInput(inputId = "quality.metrics",
+                                label = "Metrics:",
+                                choices = .qualityMetrics)),
 
                         tabPanel(title = "Alpha", value = "alpha",
 
                             selectInput(inputId = "alpha.index",
-                                label = "Metric:", multiple = TRUE,
+                                label = "Metrics:", multiple = TRUE,
                                 choices = .alphaMetrics)),
 
                         tabPanel(title = "Beta", value = "beta",

R/observers.R

@@ -212,31 +212,51 @@
 
 #' @rdname create_observers
 #' @importFrom stats as.formula
-#' @importFrom mia addAlpha runNMDS runRDA getDissimilarity
+#' @importFrom mia addAlpha runNMDS runRDA getDissimilarity addHierarchyTree
+#'   addPrevalence addPrevalentAbundance
 #' @importFrom TreeSummarizedExperiment rowTree
 #' @importFrom scater runMDS runPCA
+#' @importFrom scuttle addPerCellQC
 #' @importFrom vegan vegdist
 .create_estimate_observers <- function(input, rObjects) {
 
     # nocov start
     observeEvent(input$compute, {
 
-        if( input$estimate == "alpha" ){
-          
+        if( input$estimate == "quality" ){
+        
+            isolate({
+                req(input$estimate.assay)
+        
+                for( qmetric in input$quality.metrics ){
+                
+                    qfun <- eval(parse(text = paste0("add", qmetric)))
+                    
+                    qfun_args <- list(x = rObjects$tse,
+                        assay.type = input$estimate.assay)
+                
+                    rObjects$tse <- .update_tse(rObjects$tse, qfun, qfun_args)
+                
+                }
+        
+            })
+        
+        }else if( input$estimate == "alpha" ){
+        
             if( is.null(input$alpha.index) ){
                 .print_message("Please select one or more metrics.")
                 return()
             }
 
             isolate({
                 req(input$estimate.assay)
-              
+            
                 if( input$estimate.name != "" ){
                     name <- input$estimate.name
                 } else {
                     name <- input$alpha.index
                 }
-          
+            
                 fun_args <- list(x = rObjects$tse, name = name,
                     assay.type = input$estimate.assay, index = input$alpha.index)
 
@@ -338,9 +358,6 @@
           updateSelectInput(session, inputId = "estimate.assay",
               choices = assayNames(rObjects$tse))
 
-          updateSelectInput(session, inputId = "estimate.assay",
-              choices = assayNames(rObjects$tse))
-          
           updateNumericInput(session, inputId = "ncomponents",
               max = nrow(rObjects$tse) - 1)
 

R/utils.R

@@ -61,7 +61,7 @@ NULL
 }
 
 #' @rdname utils
-.update_tse <- function(tse, fun, fun.args) {
+.update_tse <- function(tse, fun, fun.args = list()) {
 
     tse <- tryCatch({withCallingHandlers({
 
@@ -119,6 +119,8 @@ NULL
 }
 
 #' @importFrom mia importBIOM
+#' @importFrom SummarizedExperiment colData
+#' @importFrom TreeSummarizedExperiment rowTree
 #' @importFrom S4Vectors DataFrame
 #' @importFrom ape read.tree
 #' @importFrom utils read.table