Merge pull request #78 from uclahs-cds/nzeltser-fix-densityplot-bug

fix densityplot bug

Author: alkaZeltser

NEWS.md

@@ -7,6 +7,7 @@
 
 ## Added
 * Added new contributor
+* Added minimum sample size check for grouped density curves
 
 # ApplyPolygenicScore 3.0.2
 

R/plot-pgs.R

@@ -183,20 +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]];
 
+                # handle case where all categories have fewer than 2 samples
+                if (length(pgs.data.for.plotting) == 0) {
+                    # issue a warning
+                    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

@@ -195,7 +195,7 @@ test_that(
                 )
             );
 
-        # 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'
+                )
+            );
+
         }
     );