Reorder upSetR output to return p_overview in overviewPerMarkerQC; re…

…move redundant formating.

R/markerQC.R

@@ -162,44 +162,29 @@ perMarkerQC <- function(indir, qcdir=indir, name,
 #' overview <- overviewPerMarkerQC(fail_markers)
 #' }
 overviewPerMarkerQC <- function(results_perMarkerQC, interactive=FALSE) {
-    list2counts <- function(element, all_names) {
-        all_names[!(all_names %in% element)] <- 0
-        all_names[all_names %in% element] <- 1
-        return(as.numeric(all_names))
-    }
     if (length(perMarkerQC) == 2 &&
         !all(names(results_perMarkerQC) == c("fail_list", "p_markerQC"))) {
         stop("results_perMarkerQC not direct output of perMarkerQC")
     }
     fail_list <- results_perMarkerQC$fail_list
-    # Remove null elements
-    fail_list <- fail_list[!sapply(fail_list, is.null)]
-
-    unique_samples_fail_all <- unique(unlist(fail_list))
 
     # overview QC fails
     unique_markers_fail <- unique(unlist(fail_list))
-    fail_counts <- sapply(fail_list, list2counts, unique_markers_fail)
+    fail_counts <- UpSetR::fromList(fail_list)
     rownames(fail_counts) <-  unique_markers_fail
 
-        if (length(fail_list) >= 2) {
-            p <- UpSetR::upset(UpSetR::fromList(fail_list),
-                      order.by = "freq",
-                      empty.intersections = "on", text.scale=1.2,
-                      # Include when UpSetR v1.4.1 is released
-                      # title="Overview quality control failures",
-                      mainbar.y.label="Markers failing multiple QC checks",
-                      sets.x.label="Marker fails per QC check",
-                      main.bar.color="#1b9e77", matrix.color="#1b9e77",
-                      sets.bar.color="#d95f02")
-        } else {
-            message("overviewMarkerQC cannot be displayed with UpSetR: at ",
-                    "least two elements in list required, but only ",
-                    length(fail_list) ," provided")
-        }
-        p_overview <- cowplot::plot_grid(NULL, p$Main_bar, p$Sizes, p$Matrix,
-                                         nrow=2, align='v', rel_heights = c(3,1),
-                                         rel_widths = c(2,3))
+    p <- UpSetR::upset(fail_counts,
+                       order.by = "freq",
+                       empty.intersections = "on", text.scale=1.2,
+                       # Include when UpSetR v1.4.1 is released
+                       # title="Overview quality control failures",
+                       mainbar.y.label="Markers failing multiple QC checks",
+                       sets.x.label="Marker fails per QC check",
+                       main.bar.color="#1b9e77", matrix.color="#1b9e77",
+                       sets.bar.color="#d95f02")
+    p_overview <- cowplot::plot_grid(NULL, p$Main_bar, p$Sizes, p$Matrix,
+                                     nrow=2, align='v', rel_heights = c(3,1),
+                                     rel_widths = c(2,3))
     if (interactive) {
         print(p_overview)
     }

tests/testthat/test-markerQC.R

@@ -24,9 +24,3 @@ test_that('check_maf throws file error',{
                            verbose=FALSE),
                  "plink family file")
 })
-
-test_that('overviewPerMarkerQC returns QC fails message', {
-    results_perMarkerQC <- list(fail_list=list(a=1:10), p_markerQC=NULL)
-    expect_message(overviewPerMarkerQC(results_perMarkerQC, interactive=TRUE),
-                    "overviewMarkerQC cannot be displayed with UpSetR")
-})