Merge pull request #66 from uclahs-cds/nzeltser-fix-plotting-bug

Nzeltser fix plotting bug

R/plot-pgs.R

@@ -157,7 +157,7 @@ create.pgs.density.plot <- function(
 
         # prettify x-axis labels (handle exponential notation)
         basic.xaxis.formatting <- BoutrosLab.plotting.general::auto.axis(
-            stats::quantile(unlist(pgs.data.for.plotting), probs = c(0.1, 0.9)),
+            stats::quantile(unlist(pgs.data.for.plotting), probs = c(0.1, 0.9), na.rm = TRUE),
             log.scaled = FALSE,
             num.labels = 3,
             include.origin = FALSE
@@ -200,7 +200,7 @@ create.pgs.density.plot <- function(
                     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(
-                        quantile(unlist(pgs.data.for.plotting), probs = c(0.1, 0.9)),
+                        quantile(unlist(pgs.data.for.plotting), probs = c(0.1, 0.9), na.rm = TRUE),
                         log.scaled = FALSE,
                         num.labels = 3,
                         include.origin = FALSE
@@ -237,7 +237,7 @@ create.pgs.density.plot <- function(
                     }
 
                 group.xaxis.formatting <- BoutrosLab.plotting.general::auto.axis(
-                    quantile(unlist(pgs.data.for.plotting), probs = c(0.1, 0.9)),
+                    quantile(unlist(pgs.data.for.plotting), probs = c(0.1, 0.9), na.rm = TRUE),
                     log.scaled = FALSE,
                     num.labels = 3,
                     include.origin = FALSE

tests/testthat/generate-test-data.R

@@ -226,9 +226,9 @@ alt.alleles <- rep('T', length(genotypes));
 alt.alleles[genotypes == 1] <- 'A';
 alt.alleles[genotypes == 2] <- 'A';
 
-binary.phenotype <- rbinom(n.samples, size = 1, prob = 0.5); # random binary phenotype values
+binary.phenotype <- rbinom(n.samples + 1, size = 1, prob = 0.5); # random binary phenotype values
 binary.factor.phenotype <- factor(binary.phenotype, levels = c(0, 1), labels = c('control', 'case'));
-categorical.phenotype <- factor(sample(letters[1:5], n.samples, replace = TRUE)); # random categorical phenotype values
+categorical.phenotype <- factor(sample(letters[1:5], n.samples + 1, replace = TRUE)); # random categorical phenotype values
 
 phenotype.test.data <- list(
     # vcf with 10 samples and 10 variants
@@ -249,8 +249,8 @@ phenotype.test.data <- list(
         beta = rnorm(10) # random beta values
         ),
 phenotype.data = data.frame(
-        Indiv = paste0('sample', 1:n.samples),
-        continuous.phenotype = rnorm(n.samples), # random phenotype values
+        Indiv = paste0('sample', 1:(n.samples + 1)), # add an extra sample with no genotype data
+        continuous.phenotype = rnorm(n.samples + 1), # random phenotype values
         binary.phenotype = binary.phenotype,
         binary.factor.phenotype = binary.factor.phenotype,
         categorical.phenotype = categorical.phenotype

tests/testthat/test-pgs-statistics.R

@@ -138,9 +138,9 @@ test_that(
         pgs <- seq(0, 1, length.out = nrow(phenotype.test.data$phenotype.data));
         phenotype.columns <- c('continuous.phenotype', 'binary.phenotype');
         phenotype.data <- phenotype.test.data$phenotype.data[ , phenotype.columns];
-        phenotype.data$binary.factor <- rep(c('a', 'b'), 5); # should be included in the regression
-        phenotype.data$categorical.phenotype <- rep(c('a', 'b', 'c', 'd', 'e'), 2); # should not be included in the regression
-        phenotype.data$binary.factor <- rep(c('a', 'b'), 5);
+        phenotype.data$binary.factor <- c(rep(c('a', 'b'), 5), 'a'); # should be included in the regression
+        phenotype.data$categorical.phenotype <- c(rep(c('a', 'b', 'c', 'd', 'e'), 2), 'f'); # should not be included in the regression
+        phenotype.data$binary.factor <- c(rep(c('a', 'b'), 5), 'a');
 
         # run function
         regression.data <- run.pgs.regression(pgs = pgs, phenotype.data = phenotype.data);
@@ -177,8 +177,8 @@ test_that(
         pgs <- seq(0, 1, length.out = nrow(phenotype.test.data$phenotype.data));
         phenotype.columns <- c('continuous.phenotype', 'binary.phenotype');
         phenotype.data <- phenotype.test.data$phenotype.data[ , phenotype.columns];
-        phenotype.data$binary.factor <- rep(c('a', 'b'), 5); # should be included in the regression
-        phenotype.data$categorical.phenotype <- rep(c('a', 'b', 'c', 'd', 'e'), 2); # should not be included in the regression
+        phenotype.data$binary.factor <- c(rep(c('a', 'b'), 5), 'a'); # should be included in the regression
+        phenotype.data$categorical.phenotype <- c(rep(c('a', 'b', 'c', 'd', 'e'), 2), 'f'); # should not be included in the regression
 
         # run function
         regression.data <- run.pgs.regression(pgs = pgs, phenotype.data = phenotype.data);