From 2429a7899e8793e0d485274c0626b4ea02fb2002 Mon Sep 17 00:00:00 2001
From: Nicole Zeltser <nicole.zeltser@gmail.com>
Date: Tue, 1 Oct 2024 15:04:06 -0700
Subject: [PATCH 1/2] fix NA handling

---
 R/plot-pgs.R | 6 +++---
 1 file changed, 3 insertions(+), 3 deletions(-)

diff --git a/R/plot-pgs.R b/R/plot-pgs.R
index 87ee2fd..b6596ff 100644
--- a/R/plot-pgs.R
+++ b/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

From 3621b316a886c1e28ec12415ce81514eefd9c51f Mon Sep 17 00:00:00 2001
From: Nicole Zeltser <nicole.zeltser@gmail.com>
Date: Tue, 1 Oct 2024 15:04:48 -0700
Subject: [PATCH 2/2] add test data with missing extra phenotype sample

---
 tests/testthat/data/phenotype.test.data.Rda | Bin 950 -> 969 bytes
 tests/testthat/generate-test-data.R         |   8 ++++----
 tests/testthat/test-pgs-statistics.R        |  10 +++++-----
 3 files changed, 9 insertions(+), 9 deletions(-)

diff --git a/tests/testthat/data/phenotype.test.data.Rda b/tests/testthat/data/phenotype.test.data.Rda
index 21e4232ee328c0647613bf2af7f3835875c23372..743b44ddc3b62b4da58c10787afe8f100af5e5b9 100644
GIT binary patch
delta 410
zcmV;L0cHNS2gwJJ83AOm8UX@T=UT@EwQPQ|f9Yr08~g|M+JAj|y2((RasQcT0^UzE
zr0jn<m#s5>Q?&ob@r|rDvfTEMwyHmQAGF(k|CX0&C;BGapI-b^`>ce#{S6=Hv~^*Z
zA(L?eD1R&omm8{k&^1F)`G(N=;okp1m}61$iKY9m2D|dV4Ab2I!AEp+zL)9#k7|5<
za~EsdU(RJt<vXNie`kG#plxlV{c7d79oydiuz%ZZE--E7EC+_PNoTgDWbD76%lrG`
zlcWPomAV~#J>1Zs;)Z4jMg~lPE(YW?!}P$W_kXZW3!?E+3K_PX)UwnZSfRuO3zX#i
zypp2)9C)S&=UA+<&Xxwu==nv^n1wlq8O?eSjXYZjlV^dL%8s5q853cQBp4$Z#(<B>
z5#=Q8sUNw_76ExSGp{tiv{(<mx&$gGkd&F1SX7B2E)Erk*n}Z1nw(gYnx0>jnVgt|
zBr{2FzWIv9E6lJ2T9%v!Sp@^(^B1HS>y@Wwre~BO3-ck?%|MpSfQ!<90Ad;GmU<%q
E0I^=sQ2+n{

delta 391
zcmV;20eJq&2et>083AIk8UX@UZ?9n9v9#;E{cq0gN96At+kakOZ!mA;R{M*q;u2XE
zQ}=&3F{|@|>(TuWR(;c7!TrPj=a0pvl8*)Vf0X-wS0Z|y{jZ-X&o$Tl-+%7?h8@zo
zVjz=n0w{kx33m`SLm=^S_uGHvclRszzu04QE%5Rb2S#I#7Ypv*+5a`N*<iWB9{c-y
z!aG;I53&EeFZSLJ=XU!iJ{!+eFS%xaD{j)7%dg_>U#9XhKavaGf4Iqz&vQ#GG)TCh
z37?Sx6QGGP!_>p3@UTt&A@NZP5w@JvveX<{p~HU!^K^24UP)1Y4m?wXb0pSSWlIBQ
z<oqIN%)y+(jAk{6MxG61MmU8XJ?Swf!Wc;~Mly^6A8#YdIoMM+a(OHQ@@QsWX?|(3
z9(?5pR8Al%GcU2I5<^@ZDh{y;Ls~RBu_QG;zbG>~F$YPK!aRZE6=qmsEK5#<tZ;$w
l`3oP?i}lJ=Gt)ClkcIgWYhobFVZg=YKL9G&wr*A<001aeyfOd)

diff --git a/tests/testthat/generate-test-data.R b/tests/testthat/generate-test-data.R
index 5f4f916..b490e6e 100644
--- a/tests/testthat/generate-test-data.R
+++ b/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
diff --git a/tests/testthat/test-pgs-statistics.R b/tests/testthat/test-pgs-statistics.R
index ec2b6bb..a77b118 100644
--- a/tests/testthat/test-pgs-statistics.R
+++ b/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);