tests/testthat/test-regression.R

In cdcanthro: Standardized Metrics Based on the CDC and WHO Growth Charts

# Regression values computed with the real CDC and WHO reference tables.
# They pin current results so that refactoring (e.g. speed changes) cannot
# alter any output without a test failing. If a value changes on purpose,
# regenerate these numbers and note why in NEWS.md.

test_that("cdc_z() reproduces the stored values", {
  d <- data.frame(
    sex    = c(1, 2, 1, 2, 1, 2, 1, 2, 1, 2),
    agemos = c(30.5, 30.5, 61.3, 74.8, 102, 119.6, 150.25, 171.9, 205.4, 229.7),
    wt     = c(11.2, 14.9, 18.1, 28, 24.5, 61, 39.8, 95, 70.2, 140),
    ht     = c(88, 92.5, 112, 118.5, 129, 140.2, 152.3, 160, 177.4, 165.1))
  out <- cdc_z(d)
  expected <- list(
    waz         = c(-1.81697352031, 1.10849868973, -0.226869822369, 1.62369404912, -0.658524446275, 2.47049904907, -0.413601043716, 2.40701688193, 0.454843711292, 2.83185734776),
    haz         = c(-0.90439337176, 0.573157780948, 0.512289380496, 0.407781855687, -0.297100784352, 0.354546886004, -0.0280770614213, -0.15279346821, 0.273266146899, 0.282958873463),
    bmiz        = c(-1.70046854764, 0.977322292351, -0.942600363131, 1.77585749781, -0.848923946588, 2.71740293336, -0.440370343314, 2.55814352125, 0.33439730463, 3.38264746352),
    bmip        = c(4.45214138321, 83.5795189914, 17.2942677015, 96.2121796077, 19.7961806489, 99.6710177408, 32.9834450358, 99.4738367454, 63.0960113471, 99.964104638),
    orig_bmiz   = c(-1.70046854764, 0.977322292351, -0.942600363131, 1.88213634876, -0.848923946588, 2.47552562681, -0.440370343314, 2.39856553413, 0.33439730463, 2.47804295716),
    mod_waz     = c(-1.84011741692, 0.987719444687, -0.277969136488, 1.46623698573, -0.804516675399, 2.83551188909, -0.521865458806, 2.81672257355, 0.33049463773, 4.74409537729),
    mod_haz     = c(-0.921280712167, 0.570083985739, 0.516532739613, 0.389835055976, -0.304084793315, 0.344311900175, -0.0287561925588, -0.153272234115, 0.279754893243, 0.283764601741),
    mod_bmiz    = c(-1.7428693335, 0.860424986064, -1.05998272904, 1.78690465488, -1.01530775736, 3.28706276082, -0.573191661418, 3.06471406247, 0.209751111249, 4.10502844644),
    bmip95      = c(77.4622760329, 93.7455858647, 80.3384566948, 105.048551691, 71.7241597464, 135.548892161, 69.4859832263, 134.890692444, 78.797725092, 165.138529429),
    perc_median = c(-10.996579539, 8.79824488052, -6.37318824451, 30.7510171855, -7.67056426039, 84.5208730001, -5.33184237227, 90.1001457057, 4.76051113798, 138.0831127)
  )
  for (v in names(expected))
    expect_equal(out[[v]], expected[[v]], tolerance = 1e-10, label = v)
})

test_that("who_z() reproduces the stored values", {
  d <- data.frame(
    sex     = c(1, 2, 1, 2, 1, 2, 1, 2, 1, 2),
    agedays = c(0, 14, 61, 183, 365, 550, 700, 731, 1200, 1826),
    wt      = c(3.4, 3.9, 5.1, 8.9, 9.6, 8.1, 14.9, 11, 15.2, 30),
    lenhei  = c(50.1, 52, 56.9, 66, 75.7, 77.9, 83, 86.4, 98, 108.2),
    headc   = c(34.5, 36, 38.4, 43.5, 46.2, 44.6, 48.9, 47.7, 50.1, 51))
  out <- who_z(d)
  expected <- list(
    who_waz    = c(0.109124703908, 0.624295411866, -0.707808586005, 1.60994784108, -0.0437480710326, -1.96981175308, 1.93811689512, -0.347538032298, 0.152383803556, 3.09820502486),
    who_lhaz   = c(0.113992035188, 0.256456420017, -0.769066887496, 0.109832448871, -0.0164556641105, -0.990111022095, -1.31523491572, 0.207663382514, -0.0708692278318, -0.256321977),
    who_bmiz   = c(0.107615754521, 0.729876357776, -0.409412176523, 2.06653146953, -0.0347823041844, -1.97196012864, 3.7548784573, -0.754326077785, 0.257607378084, 5.01475949888),
    who_headcz = c(0.0300728354046, 0.674795625502, -0.62658036773, 0.991665961979, 0.106092163732, -1.19771421748, 0.575565763152, 0.369467788137, 0.27337170152, 0.757313749232),
    who_wflz   = c(0.172343599032, 0.310040446624, 0.00785867887146, 2.08421989144, -0.055120002171, -2.06038618426, 3.49039611303, NA, NA, NA),
    fwaz       = c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0),
    flhaz      = c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0),
    fbmiz      = c(0, 0, 0, 0, 0, 0, 0, 0, 0, 1),
    fheadcz    = c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0),
    fwflz      = c(0, 0, 0, 0, 0, 0, 0, NA, NA, NA)
  )
  for (v in names(expected))
    expect_equal(out[[v]], expected[[v]], tolerance = 1e-10, label = v)
})