tests/testthat/test-basis-factor-hk.R

In cmstatr: Statistical Methods for Composite Material Data

suppressMessages(library(dplyr))

vangel1994 <- tribble(
  ~n, ~z, ~p, ~conf,
  3,  13.976451, 0.90, 0.90,
  5,  4.1011886, 0.90, 0.90,
  7,  2.5440993, 0.90, 0.90,
  9,  1.9368858, 0.90, 0.90,
  11, 1.6127559, 0.90, 0.90,
  13, 1.4096961, 0.90, 0.90,
  15, 1.2695586, 0.90, 0.90,
  17, 1.1663923, 0.90, 0.90,
  19, 1.0868640, 0.90, 0.90,
  21, 1.0234110, 0.90, 0.90,
  3,  28.820048, 0.90, 0.95,
  5,  6.1981307, 0.90, 0.95,
  7,  3.4780112, 0.90, 0.95,
  9,  2.5168762, 0.90, 0.95,
  11, 2.0312134, 0.90, 0.95,
  13, 1.7377374, 0.90, 0.95,
  15, 1.5403989, 0.90, 0.95,
  17, 1.3979806, 0.90, 0.95,
  19, 1.2899172, 0.90, 0.95,
  21, 1.2048089, 0.90, 0.95,
  23, 1.1358259, 0.90, 0.95,
  25, 1.0786237, 0.90, 0.95,
  27, 1.0303046, 0.90, 0.95,
  3,  147.51275, 0.90, 0.99,
  5,  14.993461, 0.90, 0.99,
  7,  6.6442464, 0.90, 0.99,
  9,  4.2798170, 0.90, 0.99,
  11, 3.2197376, 0.90, 0.99,
  13, 2.6267547, 0.90, 0.99,
  15, 2.2493289, 0.90, 0.99,
  17, 1.9880239, 0.90, 0.99,
  19, 1.7961467, 0.90, 0.99,
  21, 1.6490109, 0.90, 0.99,
  23, 1.5323809, 0.90, 0.99,
  25, 1.4374854, 0.90, 0.99,
  27, 1.3586292, 0.90, 0.99,
  29, 1.2919549, 0.90, 0.99,
  31, 1.2347570, 0.90, 0.99,
  33, 1.1850813, 0.90, 0.99,
  35, 1.1414809, 0.90, 0.99,
  37, 1.1028613, 0.90, 0.99,
  39, 1.0683787, 0.90, 0.99,
  41, 1.0373720, 0.90, 0.99,
  43, 1.0093159, 0.90, 0.99,
  3,  20.478521, 0.95, 0.90,
  5,  5.8872014, 0.95, 0.90,
  7,  3.6322326, 0.95, 0.90,
  9,  2.7593956, 0.95, 0.90,
  11, 2.2953853, 0.95, 0.90,
  13, 2.0054547, 0.95, 0.90,
  15, 1.8057261, 0.95, 0.90,
  17, 1.6588820, 0.95, 0.90,
  19, 1.5457939, 0.95, 0.90,
  21, 1.4556317, 0.95, 0.90,
  23, 1.3817937, 0.95, 0.90,
  25, 1.3200198, 0.95, 0.90,
  27, 1.2674334, 0.95, 0.90,
  29, 1.2220187, 0.95, 0.90,
  31, 1.1823195, 0.95, 0.90,
  33, 1.1472560, 0.95, 0.90,
  35, 1.1160097, 0.95, 0.90,
  37, 1.0879479, 0.95, 0.90,
  39, 1.0625739, 0.95, 0.90,
  41, 1.0394913, 0.95, 0.90,
  43, 1.0183802, 0.95, 0.90,
  3,  42.149579, 0.95, 0.95,
  5,  8.8719351, 0.95, 0.95,
  7,  4.9501721, 0.95, 0.95,
  9,  3.5743714, 0.95, 0.95,
  11, 2.8819079, 0.95, 0.95,
  13, 2.4645176, 0.95, 0.95,
  15, 2.1843450, 0.95, 0.95,
  17, 1.9824011, 0.95, 0.95,
  19, 1.8293163, 0.95, 0.95,
  21, 1.7088376, 0.95, 0.95,
  23, 1.6112408, 0.95, 0.95,
  25, 1.5303474, 0.95, 0.95,
  27, 1.4620403, 0.95, 0.95,
  29, 1.4034674, 0.95, 0.95,
  31, 1.3525889, 0.95, 0.95,
  33, 1.3079057, 0.95, 0.95,
  35, 1.2682903, 0.95, 0.95,
  37, 1.2328780, 0.95, 0.95,
  39, 1.2009936, 0.95, 0.95,
  41, 1.1721022, 0.95, 0.95,
  43, 1.1457739, 0.95, 0.95,
  45, 1.1216591, 0.95, 0.95,
  47, 1.0994706, 0.95, 0.95,
  49, 1.0789699, 0.95, 0.95,
  51, 1.0599573, 0.95, 0.95,
  53, 1.0422642, 0.95, 0.95,
  55, 1.0257472, 0.95, 0.95,
  57, 1.0102836, 0.95, 0.95
)

test_that("Extended Hanson-Koopman matches median results from Vangel 1994", {
  # Vangel (1994) provides extensive tables of z for the case where i=1 and
  # j is the median observation. This test checks the results of this
  # package's function against those tables. Only the odd values of n
  # are checked so that the median is a single observation.

  vangel1994 %>%
    rowwise() %>%
    mutate(
      z_calc = hk_ext_z(n, 1, ceiling(n / 2), p, conf)
    ) %>%
    mutate(expect_equal(z, z_calc, tolerance = 0.00005,
                        label = paste0("Mismatch in `z` for n=", n,
                                       ", p=", p,
                                       " conf=", conf, ".\n",
                                       "z_vangel=", z,
                                       ", z_calc=", z_calc, "\n")))
})

cmh_17_1g_8_5_14 <- tribble(
  ~n, ~r, ~k,
  2, 2, 35.177,
  3, 3, 7.859,
  4, 4, 4.505,
  5, 4, 4.101,
  6, 5, 3.064,
  7, 5, 2.858,
  8, 6, 2.382,
  9, 6, 2.253,
  10, 6, 2.137,
  11, 7, 1.897,
  12, 7, 1.814,
  13, 7, 1.738,
  14, 8, 1.599,
  15, 8, 1.540,
  16, 8, 1.485,
  17, 8, 1.434,
  18, 9, 1.354,
  19, 9, 1.311,
  20, 10, 1.253,
  21, 10, 1.218,
  22, 10, 1.184,
  23, 11, 1.143,
  24, 11, 1.114,
  25, 11, 1.087,
  26, 11, 1.060,
  27, 11, 1.035,
  28, 12, 1.010
)

test_that("Extended HK matches CMH-17-1G Table 8.5.14", {
  # CMH-17-1G uses the optimal order statistic approach suggested by
  # Vangel (1994) for computing B-Basis values. There are a few values
  # of n where this package's implementation finds a different optimum order
  # statistic than CMH-17-1G uses. In these cases, the order statistic that
  # this package and CMH-17-1G are both very nearly optimal. These differences
  # are ignored in this test.

  cmh_17_1g_8_5_14 %>%
    rowwise() %>%
    mutate(z = hk_ext_z_j_opt(n, 0.90, 0.95)$z) %>%
    mutate(j = hk_ext_z_j_opt(n, 0.90, 0.95)$j) %>%
    filter(
      n != 17 & n != 20 & n != 23 & n != 24 & n != 28
    ) %>%
    mutate(expect_equal(j, r,
                        label = paste0("Mismatch in `j`/`r` for n=", n, ", ",
                                       "r_B_cmh=", r,
                                       ", j=", j, "\n"))) %>%
    mutate(expect_equal(z, k, tolerance = 0.005,
                        label = paste0("Mismatch in `k`/`z` for n=", n, ", ",
                                       "k_B_cmh=", k,
                                       ", z_calc=", z, "\n")))
})

cmh_17_1g_8_5_15 <- tribble(
  ~n, ~k,
  2, 80.0038,
  3, 16.9122,
  4, 9.49579,
  5, 6.89049,
  6, 5.57681,
  7, 4.78352,
  8, 4.25011,
  9, 3.86502,
  10, 3.57267,
  11, 3.34227,
  12, 3.1554,
  13, 3.00033,
  14, 2.86924,
  15, 2.75672,
  16, 2.65889,
  17, 2.5729,
  18, 2.4966,
  19, 2.42833,
  20, 2.36683,
  21, 2.31106,
  22, 2.2602,
  23, 2.21359,
  24, 2.17067,
  25, 2.131,
  26, 2.09419,
  27, 2.05991,
  28, 2.0279,
  29, 1.99791,
  30, 1.96975,
  31, 1.94324,
  32, 1.91822,
  33, 1.89457,
  34, 1.87215,
  35, 1.85088,
  36, 1.83065,
  37, 1.81139,
  38, 1.79301,
  39, 1.77546,
  40, 1.75868,
  41, 1.7426,
  42, 1.72718,
  43, 1.71239,
  44, 1.69817,
  45, 1.68449,
  46, 1.67132,
  47, 1.65862,
  48, 1.64638,
  49, 1.63456,
  50, 1.62313,
  52, 1.60139,
  54, 1.58101,
  56, 1.56184,
  58, 1.54377,
  60, 1.5267,
  62, 1.51053,
  64, 1.4952,
  66, 1.48063,
  68, 1.46675,
  70, 1.45352,
  72, 1.44089,
  74, 1.42881,
  76, 1.41724,
  78, 1.40614,
  80, 1.39549,
  82, 1.38525,
  84, 1.37541,
  86, 1.36592,
  88, 1.35678,
  90, 1.34796,
  92, 1.33944,
  94, 1.3312,
  96, 1.32324,
  98, 1.31553,
  100, 1.30806,
  105, 1.29036,
  110, 1.27392,
  115, 1.25859,
  120, 1.24425,
  125, 1.2308,
  130, 1.21814,
  135, 1.2062,
  140, 1.19491,
  145, 1.18421,
  150, 1.17406,
  155, 1.1644,
  160, 1.15519,
  165, 1.1464,
  170, 1.13801,
  175, 1.12997,
  180, 1.12226,
  185, 1.11486,
  190, 1.10776,
  195, 1.10092,
  200, 1.09434,
  205, 1.08799,
  210, 1.08187,
  215, 1.07595,
  220, 1.07024,
  225, 1.06471,
  230, 1.05935,
  235, 1.05417,
  240, 1.04914,
  245, 1.04426,
  250, 1.03952,
  275, 1.01773
)

test_that("Extended Hanson-Koopman matches CMH-17-1G Table 8.5.15", {
  # for A-Basis, CMH-17-1G uses the order statistics for 1 and n
  # to compute the tolerance limits. This test verifies that the code
  # in this package computes the same values of z (k, as CMH-17 calls it)
  cmh_17_1g_8_5_15 %>%
    rowwise() %>%
    mutate(z = hk_ext_z(n, 1, n, 0.99, 0.95)) %>%
    mutate(expect_equal(z, k, tolerance = 0.00005,
                        label = paste0("Mismatch in `k`/`z` for n=", n, ", ",
                                       "k_A_cmh=", k,
                                       ", z_calc=", z, "\n")))
})