feat: Updates to QC flag print out and associated markdown vignettes,…

… tests, and fixtures

R/qc_preprocessing.R

@@ -353,14 +353,18 @@ qcProc <-  function(object,
   # Gather the additional QC data
 
   ## Additional QC column names
-  add.qc.column.names <- c("Raw",
-                           "NTC",
+  add.qc.column.names <- c("Raw", 
                            "Trimmed (%)",
                            "Stitched (%)",
                            "Aligned (%)",
                            "Saturated (%)",
                            "NegGeoMean")
 
+  ## Check for NTC column
+  if("NTC" %in% colnames(segment.qc.data)){
+    add.qc.column.names <- c("NTC", add.qc.column.names)
+  }
+
   ## Additional QC data
   add.qc.columns <- segment.qc.data[, add.qc.column.names]
   add.qc.columns <- rownames_to_column(add.qc.columns, var = "SampleID")
@@ -373,12 +377,19 @@ qcProc <-  function(object,
 
   add.qc.columns$TrimmedPerc <- sapply(add.qc.columns$`Trimmed (%)`, 
                                        function(x) unname(unlist(x)))
+  add.qc.columns$TrimmedPerc <- as.vector(add.qc.columns$TrimmedPerc[,1])
+
   add.qc.columns$StitchedPerc <- sapply(add.qc.columns$`Stitched (%)`, 
                                        function(x) unname(unlist(x)))
+  add.qc.columns$StitchedPerc <- as.vector(add.qc.columns$StitchedPerc[,1])
+
   add.qc.columns$AlignedPerc <- sapply(add.qc.columns$`Aligned (%)`, 
                                        function(x) unname(unlist(x)))
+  add.qc.columns$AlignedPerc <- as.vector(add.qc.columns$AlignedPerc[,1])
+
   add.qc.columns$SaturatedPerc <- sapply(add.qc.columns$`Saturated (%)`, 
                                        function(x) unname(unlist(x)))
+  add.qc.columns$SaturatedPerc <- as.vector(add.qc.columns$SaturatedPerc[,1])
 
   ## Remove the nested data frames
   add.qc.columns <- add.qc.columns[, -which(names(add.qc.columns) == "Trimmed (%)")]
@@ -406,12 +417,13 @@ qcProc <-  function(object,
                           "LowAligned", 
                           "SaturatedPerc", 
                           "LowSaturation", 
-                          "NTC", 
-                          "HighNTC", 
                           "NegGeoMean", 
                           "LowNegatives")
 
-  ## Add area and/or nuclei if part of annotation
+  ## Add NTC, area, and/or nuclei if part of annotation
+  if("NTC" %in% annotation.column.names){ 
+    final.column.order <- c(final.column.order, "NTC", "HighNTC")
+  } 
   if("area" %in% annotation.column.names){ 
     final.column.order <- c(final.column.order, "area", "LowArea")
   } 

tests/testthat/test-qc_preprocessing.R

@@ -1,25 +1,25 @@
 test_that("Test Human Kidney dataset", {
   kidney.dat <- selectDatasetQC("kidney")
   output <- do.call(qcProc, kidney.dat)
-  expected.elements <- c("object", "plot","table")
+  expected.elements <- c("object", "plot","table","segment.flags","probe.flags")
   expect_equal(length(setdiff(expected.elements, names(output))), 0)
 })
 test_that("Test Mouse Thymus Dataset", {
   thymus.dat <- selectDatasetQC("thymus")
   output <- do.call(qcProc, thymus.dat)
-  expected.elements <- c("object", "plot","table")
+  expected.elements <- c("object", "plot","table","segment.flags","probe.flags")
   expect_equal(length(setdiff(expected.elements, names(output))), 0)
 })
 test_that("Test Colon Dataset", {
   colon.dat <- selectDatasetQC("colon")
   expect_warning(output <- do.call(qcProc, colon.dat), regexp = NULL)
-  expected.elements <- c("object", "plot","table")
+  expected.elements <- c("object", "plot","table","segment.flags","probe.flags")
   expect_equal(length(setdiff(expected.elements, names(output))), 0)
 })
 test_that("Test Human NSCLC Dataset", {
   nsclc.dat <- selectDatasetQC("nsclc") 
   expect_warning(output <- do.call(qcProc, nsclc.dat), regexp = NULL)
-  expected.elements <- c("object", "plot","table")
+  expected.elements <- c("object", "plot","table","segment.flags","probe.flags")
   expect_equal(length(setdiff(expected.elements, names(output))), 0)
 })
 test_that(

vignettes/Integration_Test_Colon.Rmd

@@ -70,7 +70,7 @@ This runs the DSPworkflow package to completion using the Human Colon Dataset:
                                 nuclei.col = "nuclei")
   
   # For creating fixture RDS
-  create.rds <- TRUE
+  create.rds <- FALSE
   if(create.rds) {
     study.design.human.colon <- sdesign.list$object
     saveRDS(study.design.human.colon, file = "tests/testthat/fixtures/Human_Colon/studyDesignHumanColon.RDS")
@@ -97,8 +97,10 @@ This runs the DSPworkflow package to completion using the Human Colon Dataset:
                         min.area = 1000,
                         print.plots = TRUE)
     print(qc.output$segments.qc)
+    print(qc.output$segment.flags)
+    print(qc.output$probe.flags)
     
-  create.rds <- TRUE
+  create.rds <- FALSE
   if(create.rds) {
     qc.human.colon<- qc.output$object
     saveRDS(qc.human.colon, file = "tests/testthat/fixtures/Human_Colon/qcHumanColon.RDS")

vignettes/Integration_Test_Mouse_Thymus.Rmd

@@ -71,7 +71,7 @@ This runs the DSPworkflow package to completion using the Mouse Thymus Dataset:
                                 nuclei.col = "nuclei")
   
   # For creating fixture RDS
-  create.rds <- TRUE
+  create.rds <- FALSE
   if(create.rds) {
     study.design.mouse.thymus <- sdesign.list$object
     saveRDS(study.design.mouse.thymus, file = "tests/testthat/fixtures/Mouse_Thymus/studyDesignMouseThymus.RDS")
@@ -99,8 +99,10 @@ qc.output <-  qcProc(object = sdesign.list$object,
                         min.area = 16000,
                         print.plots = TRUE)
     print(qc.output$segments.qc)
+    print(qc.output$segment.flags)
+    print(qc.output$probe.flags)
     
-  create.rds <- TRUE
+  create.rds <- FALSE
   if(create.rds) {
     qc.mouse.thymus <- qc.output$object
     saveRDS(qc.mouse.thymus, file = "tests/testthat/fixtures/Mouse_Thymus/qcMouseThymus.RDS")

vignettes/Integration_Test_NSCLC.Rmd

@@ -104,7 +104,7 @@ qc.output <-  qcProc(object = sdesign.list$object,
     print(qc.output$segments.qc)
     
     # For creating a fixture RDS
-    create.rds <- TRUE
+    create.rds <- FALSE
     if(create.rds) {
       qc.human.nsclc <- qc.output$object
       saveRDS(qc.human.nsclc, file = "tests/testthat/fixtures/Human_NSCLC/qcHumanNSCLC.RDS")