Merge pull request #9 from tanaylab/fix@return-na-when-lab-code-does-…

…not-exist

return NA when lab code doesn't exist

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: labNorm
 Title: Normalize Laboratory Measurements by Age and Sex
-Version: 1.0.2
+Version: 1.0.3
 Authors@R: c(
     person("Aviezer", "Lifshitz", , "[email protected]", role = c("aut", "cre")),
     person("Netta", "Mendelson-Cohen", , "[email protected]", role = "aut"),    
@@ -34,5 +34,5 @@ Imports:
     withr,
     yesno
 Depends: 
-    R (>= 2.10)
+    R (>= 4.0)
 LazyData: true

NEWS.md

@@ -1,3 +1,8 @@
+# labNorm 1.0.3
+
+* Fix: `ln_normalize_ukbb` and `ln_normalize_clalit` now return NA when the lab code is not found in the reference table.
+* Require R >= 4.0 
+
 # labNorm 1.0.2
 
 * Added `ln_normalize_ukbb` and `ln_normalize_clalit` utility function for normalizing using lab codes. 

R/ukbb.R

@@ -20,6 +20,10 @@
 #' @export
 #' @rdname ln_normalize
 ln_normalize_ukbb <- function(values, age, sex, lab_code, reference = "UKBB", na.rm = FALSE) {
+    if (!ln_ukbb_lab_code_exists(lab_code)) {
+        cli::cli_warn("Lab code {lab_code} does not exist in the UKBB reference. Returning NA.")
+        return(rep(NA, length(values)))
+    }
     ln_normalize(values = values, age = age, sex = sex, units = ln_ukbb_units(lab_code), lab = ln_ukbb_name(lab_code), reference = reference, na.rm = na.rm)
 }
 
@@ -124,6 +128,14 @@ ln_ukbb_name <- function(lab_code) {
         pull(short_name)
 }
 
+ln_ukbb_lab_code_exists <- function(lab_code) {
+    lab_code %in% LAB_DETAILS$ukbb_code
+}
+
+ln_clalit_lab_code_exists <- function(lab_code) {
+    lab_code %in% LAB_DETAILS$clalit_code
+}
+
 #' Get available UKBB labs
 #'
 #' @return A data frame with the available UKBB labs.
@@ -155,6 +167,10 @@ ln_ukbb_labs <- function() {
 #' @export
 #' @rdname ln_normalize
 ln_normalize_clalit <- function(values, age, sex, lab_code, reference = "Clalit", na.rm = FALSE) {
+    if (!ln_clalit_lab_code_exists(lab_code)) {
+        cli::cli_warn("Lab code {lab_code} does not exist in the Clalit reference. Returning NA.")
+        return(rep(NA, length(values)))
+    }
     # deafult units are based on clalit units
     ln_normalize(values = values, age = age, sex = sex, lab = ln_clalit_name(lab_code), reference = reference, na.rm = na.rm)
 }

data-raw/quantile2feature.csv

@@ -92,3 +92,4 @@
 "RDW_CV","RDW-CV","RDW-CV","","","","lab.152",NA,NA,NA,NA,NA,NA
 "LH_LUTEINIZING_HORMONE","LH","Luteinizing Hormone (LH)","IU/L|""""IU/mL""""|""""mIU/L""""|""""mIU/mL""""|""""uIU/mL""""|""""U/L""""|""""U/mL""""|""""mU/L""""|""""mU/mL""""|""""uU/mL""""","U/L","x|1000*x|0.001*x|x|0.001*x|x|1000*x|0.001*x|x|0.001*x","lab.100800",2,9,NA,NA,NA,NA
 "ESTRADIOL_E_2","Estradiol","Estradiol (E2)","pmol/L|""""pg/mL""""|""""pg/dL""""|""""pg/L""""|""""ng/L""""","pmol/L","1|3.6713*x|0.0367*x|0.0037*x|3.6713*x","lab.100500",73.4,184,36.7,660,30800,"pmol/L"
+"NRBC","NRBC","Nucleated Red Blood Cells (NRBC)","x10E3/uL|""""x10E6/uL""""|""""x10E9/L""""|""""x10E12/L""""","x10E3/uL","x|1000*x|x|1000*x",NA,0,0,0,0,30170,"x10E3/uL"

data-raw/quantiles.R

@@ -109,7 +109,7 @@ import_lab_clalit <- function(lab, raw_quantiles_dir = "/net/mraid14/export/tgda
 import_all_labs_clalit <- function(raw_quantiles_dir = "/net/mraid14/export/tgdata/users/aviezerl/src/mldpEHR-app/backend/rawdata/lab_quantiles_raw", small_size = 21, ncores = 40, parallel = TRUE) {
     doMC::registerDoMC(ncores)
 
-    labs <- features$quantile_file
+    labs <- features$quantile_file[!is.na(features$lab)]
     plyr::l_ply(labs, import_lab_clalit, raw_quantiles_dir = raw_quantiles_dir, small_size = small_size, .parallel = parallel)
 
 
@@ -295,10 +295,10 @@ plot_all_large_vs_small <- function(raw_quantiles_dir = "/net/mraid14/export/tgd
     return(stats)
 }
 
-# import_all_labs_clalit()
-# import_all_labs_ukbb()
-# create_labs_data()
+import_all_labs_clalit()
+import_all_labs_ukbb()
+create_labs_data()
 create_lab_info()
-# create_high_res_labs_data()
-# create_ukbb_labs_data()
+create_high_res_labs_data()
+create_ukbb_labs_data()
 # plot_all_large_vs_small()

tests/testthat/test-data.R

@@ -30,7 +30,7 @@ test_that("Clalit data is valid", {
         mutate(s = paste0(age, ".", sex)) %>%
         pull(s)
 
-    purrr::map(LAB_DETAILS$short_name, function(lab) {
+    purrr::map(LAB_DETAILS$short_name[!is.na(LAB_DETAILS$clalit_code)], function(lab) {
         x <- load_quantiles("Clalit", lab)
         expect_true(all(names(x) %in% field_names))
         expect_true(all(field_names %in% names(x)))
@@ -45,8 +45,8 @@ test_that("Clalit data is valid", {
 
     quantiles <- pkgenv[["Clalit"]]
 
-    expect_true(all(names(quantiles) %in% LAB_DETAILS$short_name))
-    expect_true(all(LAB_DETAILS$short_name %in% names(quantiles)))
+    expect_true(all(names(quantiles) %in% LAB_DETAILS$short_name[!is.na(LAB_DETAILS$clalit_code)]))
+    expect_true(all(LAB_DETAILS$short_name[!is.na(LAB_DETAILS$clalit_code)] %in% names(quantiles)))
 })
 
 test_that("UKBB data is valid", {
@@ -69,7 +69,7 @@ test_that("UKBB data is valid", {
         "MCV", "Monocytes, Abs", "Monocytes, %", "MPV", "Neutrophils, Abs",
         "Neutrophils, %", "PCT", "PDW", "Alk. Phosphatase", "Phosphorus",
         "Platelets", "Total Protein", "RBC", "RDW", "Triglycerides",
-        "Urea", "Vitamin D (25-OH)", "WBC"
+        "Urea", "Vitamin D (25-OH)", "WBC", "NRBC"
     )
 
 

tests/testthat/test-download.R

@@ -38,12 +38,12 @@ test_that("ln_download_data downloads to temp dir if not approved or if dir not
         "MCH", "MCHC", "MCV", "MONO(abs)", "MONperc", "MPV", "NEUT(abs)",
         "NEUTperc", "PCT", "PDW", "PHOSPHATASE_ALKALINE", "PHOSPHORUS_BLOOD",
         "PLT", "PROTEIN_TOTAL_BLOOD", "RBC", "RDW", "TRIGLYCERIDES",
-        "UREA_BLOOD", "VITAMIN_D3_25_0H_RIA", "WBC"
+        "UREA_BLOOD", "VITAMIN_D3_25_0H_RIA", "WBC", "NRBC"
     )
 
     expect_true(all(file.exists(file.path(getOption("labNorm.dir"), "UKBB", paste0(ukbb_labs, ".rds")))))
 
-    expect_true(all(file.exists(file.path(getOption("labNorm.dir"), "Clalit", paste0(LAB_TO_FILENAME, ".rds")))))
+    expect_true(all(file.exists(file.path(getOption("labNorm.dir"), "Clalit", paste0(LAB_TO_FILENAME[LAB_TO_FILENAME != "NRBC"], ".rds")))))
 
     # Check that the quantile data was read and stored correctly
     expect_equal(load_quantiles("Clalit", "WBC"), readRDS(file.path(getOption("labNorm.dir"), "Clalit", "WBC.rds")))

tests/testthat/test-normalize.R

@@ -311,3 +311,39 @@ test_that("ln_normalize_multi_ukbb works", {
         pkgenv$UKBB[["Creatinine"]][["[50,55).male"]](ln_convert_units(multi_labs_df$value[multi_labs_df$lab_code == "30700"], units = "umol/L", lab = "Creatinine"))
     )
 })
+
+test_that("ln_normalize_ukbb returns NA when code doesn't exist", {
+    skip_on_cran()
+    clean_downloaded_data()
+
+    hemoglobin_50 <- hemoglobin_data %>%
+        filter(age == 50, sex == "male")
+
+    mockery::stub(ln_normalize_ukbb, "yesno2", FALSE, depth = 2)
+    expect_warning(q <- ln_normalize_ukbb(
+        hemoglobin_50$value,
+        hemoglobin_50$age,
+        hemoglobin_50$sex,
+        "30"
+    ))
+
+    expect_equal(q, rep(NA, length(hemoglobin_50$value)))
+})
+
+test_that("ln_normalize_clalit returns NA when code doesn't exist", {
+    skip_on_cran()
+    clean_downloaded_data()
+
+    hemoglobin_50 <- hemoglobin_data %>%
+        filter(age == 50, sex == "male")
+
+    mockery::stub(ln_normalize_clalit, "yesno2", FALSE, depth = 2)
+    expect_warning(q <- ln_normalize_clalit(
+        hemoglobin_50$value,
+        hemoglobin_50$age,
+        hemoglobin_50$sex,
+        "30"
+    ))
+
+    expect_equal(q, rep(NA, length(hemoglobin_50$value)))
+})