refactor sample size check

Author: alkaZeltser

R/plot-pgs.R

@@ -183,29 +183,34 @@ create.pgs.density.plot <- function(
             pgs.by.phenotype <- lapply(
                 X = pgs.by.phenotype,
                 FUN = function(x) {
-                    x <- x[sapply(x, length) > 1];
+                    large.categories <- sapply(
+                        X = x,
+                        function(y) {
+                            length(y[!is.na(y)]) > 1
+                            }
+                        );
+                    x <- x[large.categories];
                     }
                 );
 
             # iterate over phenotype variables
             for (phenotype in names(pgs.by.phenotype)) {
                 pgs.data.for.plotting <- pgs.by.phenotype[[phenotype]];
 
-                # count non-NA values per phenotype category
-                n.samples.per.category <- sapply(pgs.data.for.plotting, function(x) {length(x[!is.na(x)])});
-                if (any(n.samples.per.category < 5)) {
-                    # remove phenotype categories containing fewer than 5 samples
-                    pgs.data.for.plotting <- pgs.data.for.plotting[n.samples.per.category >= 5];
+                # handle case where all categories have fewer than 2 samples
+                if (length(pgs.data.for.plotting) == 0) {
                     # issue a warning
-                    warning(paste0(names(n.samples.per.category)[n.samples.per.category < 5], ' category has fewer than 5 samples, density curves will not be plotted'));
+                    warning(paste0('No ', phenotype, ' categories with more than 2 samples, plotting aggregated density instead'));
+                    pgs.density.by.phenotype.plots[[paste0(pgs.column,'_',phenotype)]] <- pgs.density.plots[[pgs.column]];
+                    next;
                     }
 
                 # color handling
                 max.colors <- 12;
                 max.lty <- 6;
                 max.categories <- max.colors * max.lty;
                 if (length(pgs.data.for.plotting) > max.categories) {
-                    # Issue a warning that plot is not bein color-coded
+                    # Issue a warning that plot is not being color-coded
                     warning(paste0('Skipping colors for ', pgs.column, ' and ', phenotype, ' due to too many categories'));
                     # plot all lines in black
                     group.xaxis.formatting <- BoutrosLab.plotting.general::auto.axis(

tests/testthat/test-plotting.R

@@ -190,12 +190,12 @@ test_that(
             create.pgs.density.plot(
                 pgs.data = pgs.test,
                 phenotype.columns = c('continuous.phenotype', 'binary.phenotype', 'categorical.phenotype'),
-                output.dir = temp.dir,
+                output.dir = '.',#temp.dir,
                 filename.prefix = 'TEST-all-phenotypes'
                 )
             );
 
-        # check handling of only continuous phenotype (not supposed to be plotted, how can I test for multipanel dimensions over a multipanel object?)
+        # check handling of only continuous phenotype (not supposed to be plotted
         expect_no_error(
             create.pgs.density.plot(
                 pgs.data = pgs.test,
@@ -223,6 +223,19 @@ test_that(
             file.exists(file.path(temp.dir, test.filename.continuous.phenotype))
             );
 
+
+        # check handling of categorical phenotype with fewer than 2 samples in all categories
+        low.n.test.data <- pgs.test;
+        low.n.test.data$categorical.phenotype <- paste0('cat', 1:nrow(low.n.test.data));
+        expect_warning(
+            create.pgs.density.plot(
+                pgs.data = low.n.test.data,
+                phenotype.columns = c('categorical.phenotype'),
+                output.dir = temp.dir,
+                filename.prefix = 'TEST-all-small-categories'
+                )
+            );
+
         }
     );