Update test suite for adult subjects (fixed)

R/growth.R

@@ -570,13 +570,12 @@ cleangrowth <- function(subjid,
 
   # adult: send to cleanadult to do most of the work ----
 
-  if (!quietly){
-    cat(sprintf("[%s] Begin processing adult data...\n", Sys.time()))
-  }
-
   # no need to do this if there's no data
   if (nrow(data.adult) > 0){
-    # create cluster to use and reuse
+    if (!quietly){
+      cat(sprintf("[%s] Begin processing adult data...\n", Sys.time()))
+    }
+
     # if parallel processing is desired, load additional modules
     if (parallel) {
       if (is.na(num.batches)) {
@@ -656,20 +655,23 @@ cleangrowth <- function(subjid,
     }
   }
 
+  if (any(nrow(data.all) > 0, nrow(data.adult) > 0)) {
+    # join with pediatric data
+    full_out <- data.table(
+      line = c(ret.df$line, res$line),
+      exclude = c(as.character(ret.df$exclude), res$result),
+      mean_sde = c(rep(NA, nrow(ret.df)), res$mean_sde)
+    )
+    full_out[, exclude := factor(exclude, levels = unique(c(exclude.levels,
+                                                            unique(exclude))))]
+    full_out <- full_out[order(line),]
+    # remove column added for keeping track
+    full_out[, line := NULL]
 
-  # join with pediatric data
-  full_out <- data.table(
-    line = c(ret.df$line, res$line),
-    exclude = c(as.character(ret.df$exclude), res$result),
-    mean_sde = c(rep(NA, nrow(ret.df)), res$mean_sde)
-  )
-  full_out[, exclude := factor(exclude, levels = unique(c(exclude.levels,
-                                                   unique(exclude))))]
-  full_out <- full_out[order(line),]
-  # remove column added for keeping track
-  full_out[, line := NULL]
-
-  return(full_out$exclude)
+    return(full_out$exclude)
+  } else {
+    return(c())
+  }
 
 }
 

tests/testthat/test-cleangrowth.R

@@ -1,4 +1,4 @@
-test_that("growthcleanr works as expected on synthetic data", {
+test_that("growthcleanr works as expected on pediatric synthetic data", {
 
   # Run cleangrowth() on syngrowth data
   data <- as.data.table(syngrowth)
@@ -89,11 +89,98 @@ test_that("growthcleanr works as expected on synthetic data", {
 
 })
 
+test_that("growthcleanr works as expected on adult synthetic data", {
+
+  # Run cleangrowth() on syngrowth data
+  data <- as.data.table(syngrowth)
+
+  # syngrowth hasn't changed in length
+  expect_equal(77721, data[, .N])
+  setkey(data, subjid, param, agedays)
+
+  # subset to adult data
+  data_adult <- copy(data[agedays >= 18 * 365.25, ])
+
+  # Create small sample
+  d500 <- as.data.table(data_adult)[subjid %in% unique(data_adult[, subjid])[1:500], ]
+  expect_equal(12447, d500[, .N])
+
+  # Clean sample
+  cd500 <-
+    d500[, gcr_result := cleangrowth(
+      subjid,
+      param,
+      agedays,
+      sex,
+      measurement
+    )]
+
+  # Clean again with lower cutpoint
+  cd500cp <-
+    copy(d500)[, gcr_result := cleangrowth(
+      subjid,
+      param,
+      agedays,
+      sex,
+      measurement,
+      adult_cutpoint = 18
+    )]
+
+
+  # Spot check individual results
+  gcr_result <- function (dt, rowid) {
+    return(as.character(dt[id == rowid]$gcr_result))
+  }
+
+  # These results should not change with cutpoint
+  expect_equal("Include", gcr_result(cd500, 27166))
+  expect_equal("Include", gcr_result(cd500cp, 27166))
+
+  expect_equal("Exclude-Adult-Identical-Same-Day", gcr_result(cd500, 47596))
+  expect_equal("Exclude-Adult-Identical-Same-Day", gcr_result(cd500cp, 47596))
+
+  expect_equal("Exclude-Adult-BIV", gcr_result(cd500, 41872))
+  expect_equal("Exclude-Adult-BIV", gcr_result(cd500cp, 41872))
+
+  # Results for these records should change due to younger cutpoint
+  expect_equal("Exclude-Extraneous-Same-Day", gcr_result(cd500, 38722))
+  expect_equal("Exclude-Adult-Extraneous-Same-Day", gcr_result(cd500cp, 38722))
+
+  expect_equal("Exclude-Carried-Forward", gcr_result(cd500, 12923))
+  expect_equal("Include", gcr_result(cd500cp, 12923))
+
+  expect_equal("Exclude-Extraneous-Same-Day", gcr_result(cd500, 25259))
+  expect_equal("Exclude-Adult-Distinct-3-Or-More", gcr_result(cd500cp, 25259))
+
+  # Check counts of exclusions by category
+  catcount <- function (df, category) {
+    return(as.numeric(df %>% filter(gcr_result == category) %>% select(n)))
+  }
+
+  d500_exclusions <-
+    cd500 %>% group_by(gcr_result) %>% tally(sort = TRUE)
+  expect_equal(9745, catcount(d500_exclusions, "Include"))
+  expect_equal(2090, catcount(d500_exclusions, "Exclude-Adult-Extraneous-Same-Day"))
+  expect_equal(59, catcount(d500_exclusions, "Exclude-Adult-Distinct-3-Or-More"))
+  expect_equal(43, catcount(d500_exclusions, "Exclude-Carried-Forward"))
+  expect_equal(2, catcount(d500_exclusions, "Exclude-Adult-Transpositions"))
+
+  d500cp_exclusions <-
+    cd500cp %>% group_by(gcr_result) %>% tally(sort = TRUE)
+  expect_equal(9774, catcount(d500cp_exclusions, "Include"))
+  expect_equal(2200, catcount(d500cp_exclusions, "Exclude-Adult-Extraneous-Same-Day"))
+  expect_equal(62, catcount(d500cp_exclusions, "Exclude-Adult-Distinct-3-Or-More"))
+  expect_true(is.na(catcount(d500cp_exclusions, "Exclude-Carried-Forward")))
+  expect_equal(2, catcount(d500cp_exclusions, "Exclude-Adult-Transpositions"))
+
+})
+
 test_that("growthcleanr works without either adult or pediatric data", {
   # creating small only adult and only pediatric data
   # using default cutpoint -- 20
   only_peds <- syngrowth[syngrowth$agedays < 20*365.25,][1:50,]
   only_adult <- syngrowth[syngrowth$agedays >= 20*365.25,][1:50,]
+  nobody <- syngrowth[syngrowth$agedays > 120*365.25,]
 
   # testing cleangrowth works without adult data
   peds_res <- cleangrowth(
@@ -102,7 +189,7 @@ test_that("growthcleanr works without either adult or pediatric data", {
     only_peds$agedays,
     only_peds$sex,
     only_peds$measurement,
-    quietly = T
+    quietly = TRUE
   )
 
   expect_equal(length(peds_res), nrow(only_peds))
@@ -114,9 +201,21 @@ test_that("growthcleanr works without either adult or pediatric data", {
     only_adult$agedays,
     only_adult$sex,
     only_adult$measurement,
-    quietly = T
+    quietly = TRUE
   )
 
   expect_equal(length(adult_res), nrow(only_adult))
 
-})
+  # testing cleangrowth works with no data
+  no_res <- cleangrowth(
+    nobody$subjid,
+    nobody$param,
+    nobody$agedays,
+    nobody$sex,
+    nobody$measurement,
+    quietly = TRUE
+  )
+
+  expect_equal(length(no_res), nrow(nobody))
+
+})