tests/testthat/test-mmcif.R

In mmcif: Mixed Multivariate Cumulative Incidence Functions

library(mmcif)
cpp_obj <- mmcif_data(
  ~ a + b, dat, cause = cause, time = time, cluster_id = cluster_id,
  max_time = delta, spline_df = 2L, left_trunc = dat$delayed_entry)

cpp_obj_knots <- mmcif_data(
  ~ a + b, dat, cause = cause, time = time, cluster_id = cluster_id,
  max_time = delta, spline_df = 2L, left_trunc = dat$delayed_entry,
  knots = lapply(cpp_obj$splines, function(x)
    list(knots = x$knots, boundary_knots = x$boundary_knots)))

comb_slope <- sapply(cpp_obj$spline, function(spline){
  boundary_knots <- spline$boundary_knots
  pts <- seq(boundary_knots[1], boundary_knots[2], length.out = 1000)
  lm.fit(cbind(1, spline$expansion(pts)), pts)$coef
})

# with(gaussHermiteData(10L), list(node = x, weight = w)) |> dput()
ghq_data <- list(
  node = c(-3.43615911883774, -2.53273167423279, -1.75668364929988, -1.03661082978951, -0.342901327223705, 0.342901327223705, 1.03661082978951, 1.75668364929988, 2.53273167423279, 3.43615911883774),
  weight = c(7.6404328552326e-06, 0.00134364574678124, 0.0338743944554811, 0.240138611082314, 0.610862633735326, 0.610862633735326, 0.240138611082315, 0.033874394455481, 0.00134364574678124, 7.64043285523265e-06))

coef_traject_spline <-
  rbind(comb_slope[-1, ] * rep(coef_traject[1, ], each = NROW(comb_slope) - 1),
        coef_traject[2, ] + comb_slope[1, ] * coef_traject[1, ],
        coef_traject[-(1:2), ])

truth <- c(coef_risk, coef_traject_spline, log_chol(Sigma))

test_that("the log composite likelihood gives the same as previously", {
  # mmcif_logLik(cpp_obj, truth, ghq_data, 1, TRUE) |> dput()
  log_compos <- -439.949278998529
  expect_equal(mmcif_logLik(cpp_obj, truth, ghq_data, 1, TRUE), log_compos)
  expect_equal(mmcif_logLik(cpp_obj, truth, ghq_data, 2, TRUE), log_compos)

  expect_equal(
    mmcif_logLik(cpp_obj_knots, truth, ghq_data, 1, TRUE), log_compos)
})

test_that("the gradient of log composite likelihood match the one from numerical differentation", {
  # numDeriv::grad(\(x) mmcif_logLik(cpp_obj, x, ghq_data, 1, TRUE), truth) |> dput()
  grad_log_compos <- c(-2.10856790649602, 27.4239565755946, 2.30429599534527, 20.0963783392411, -17.8491973129057, 1.04607771693571, -8.74030143511687, 14.2383928150414, -8.40145900230978, 18.7570071562292, -21.2130993129746, 2.06867787244102, -8.5291673063807, 4.94853852069349, 7.58574858682438, 0.0930760225780529, -1.81161748374386, -3.10896359203321, 6.59004476369612, -6.85988430981942, 4.67223350169804, 2.06253506147011, -8.23184803800954, 7.60108260892427, 0.916561613714819, -11.3836942217331)
  expect_equal(mmcif_logLik_grad(cpp_obj, truth, ghq_data, 1, TRUE),
               grad_log_compos, tolerance = 1e-6)
  expect_equal(mmcif_logLik_grad(cpp_obj, truth, ghq_data, 2, TRUE),
               grad_log_compos, tolerance = 1e-6)

  expect_equal(mmcif_logLik_grad(cpp_obj_knots, truth, ghq_data, 1, TRUE),
               grad_log_compos, tolerance = 1e-6)
})

test_that("the Hessian of log composite likelihood match the one from numerical differentation", {
  # numDeriv::jacobian(\(x) mmcif_logLik_grad(cpp_obj, x, ghq_data, 1, TRUE), truth) |> dput()
  hess_log_compos <- structure(c(
      -68.8828018669068, -4.27369322977645, 0.549078772515422,
      26.154940212274, 5.49932440335191, 0.965712213665516, -5.22925545501717,
      1.68921332556908, -13.5155195060803, -1.85038447663803, 1.43242301963591,
      2.72875999181108, -0.619158760459519, 6.43980085762911, -1.00040976541169,
      0.133577119021577, 2.71505619294448, -2.09478504524818, 12.9436650219053,
      -3.68488700510139, 2.09828291835248, -1.04373840053107, -2.82028304289215,
      5.21689325157576, 0.75356676508849, 0.135954927917376, -4.27369336651708,
      -48.1400015906004, 0.981598240743737, 5.0301712295405, 20.5333298084351,
      -0.142861460983891, 0.157770771659524, -0.552428717329887, -0.154072908956295,
      -6.65473103830594, 1.44913207884555, -0.0486630347043679, -0.0362496443248437,
      0.120301751803515, 2.42974136603907, -0.044817135288939, 2.14595443492382,
      -1.53473238173003, 2.4935610123534, -0.891854443702729, 0.727515503216603,
      0.722294413023426, -1.41540394554487, 1.30266755986483, 0.180640554656555,
      -0.256781709209193, 0.549078768467081, 0.98159826203374, -27.0928528126694,
      1.021065218468, -0.122214222800405, 10.9989104506846, 0.744442683152816,
      -0.533761421948472, 0.9804421829519, 1.41030584352159, -3.8872341180063,
      -0.0529947544540346, -0.0806300307097562, -0.129295316468187,
      -0.164923861598437, 1.52578263857606, -1.20503413830336, 0.85984234477663,
      -0.502943316391265, 2.06804116774933, -1.20384497627751, 0.144255776652718,
      -0.0240279086480214, -0.0304796301908912, -0.36548698189206,
      0.0520489972974004, 26.1549389918159, 5.03017094716173, 1.02106511312085,
      -49.3176385222621, 7.03734630508869, -0.863049889691313, 3.55802728035931,
      -0.491712742570194, 8.70616885675061, 3.02338758903578, -0.335628657096715,
      -3.32476602117375, 1.49608887803744, -8.47830480589935, 3.64532069180479,
      -0.396468085358233, -0.193511223272153, 8.13805726237364, -22.4945328445137,
      1.39752430677068, -1.79418545724593, 0.926840625352983, 3.16711768330499,
      -7.60082653531475, -1.10650323918131, 1.18445133418483, 5.49932493886724,
      20.5333296642649, -0.122214165014938, 7.03734564792708, -44.8581189393269,
      0.816976831147716, 0.417955072539928, 0.251020584200741, 0.904355666747083,
      3.20407865202302, -0.547330706292753, 1.30945518091676, -0.621104210338322,
      3.10637155646101, -7.06812775811167, 0.482488898334248, -1.0913941590115,
      1.20917148641058, 1.92908123186125, 0.471118550061374, -1.21306719877315,
      0.236247412654742, 0.592050714681733, 0.86927662156645, -0.0267994118436235,
      -0.117198304889041, 0.965712239595458, -0.142861446597201, 10.9989101245817,
      -0.863050081384934, 0.816976890794931, -19.2934220353595, -0.173042898391154,
      0.15925063681143, -0.0322140700985356, -0.415000033265299, 2.33716073683929,
      -0.0841070390881834, 0.0416436207353757, -0.141241605621962,
      0.599159386360548, -2.17891946339407, 0.404544134662541, -0.978378056603028,
      0.833348509681476, -0.553035021081492, 1.50718052403387, -0.438637360784786,
      -0.0678929272859826, -0.456358067751141, 0.200561218971456, -0.514303440371503,
      -5.22925487346317, 0.157770725643927, 0.744443431594136, 3.55802581146632,
      0.417955304837334, -0.173043121536589, -27.093503659899, 7.07473058921556,
      -37.758209772224, -27.6989311257334, 1.54663116973568, -0.563276979260669,
      -0.099232213721702, -1.29887007338471, 0.404994161388707, -0.114233010167309,
      1.10421144182088, -0.878823744030759, 1.96200861396339, -3.70783385984741,
      0.195553371250849, -7.22214932119362, 0.0597141300005027, -0.554382416918958,
      -0.132673340879103, -0.258177946572391, 1.68921341213866, -0.552428455710607,
      -0.533761642966301, -0.491712570318332, 0.251020143400402, 0.15925069915799,
      7.07473060001111, -24.3387973518298, -0.415783515579429, -4.88945160912813,
      0.320722353542141, -0.12406771520041, 0.105485821904706, -0.385190004165171,
      -0.159043236510559, -0.0338775443294418, 0.0507318003144413,
      -0.426831495764316, 0.0856557535149811, 8.82218503692372, -9.34941234900363,
      -22.3002348697486, 0.270300838013958, -0.444459082909558, -0.744525570126716,
      0.11845049749655, -13.515518067671, -0.154073308090027, 0.980443700245759,
      8.7061650655881, 0.904356979012538, -0.0322148903994628, -37.7582097481647,
      -0.415783546034304, -91.9706780541336, -45.2781775906109, -1.62740653004866,
      -1.27782164262887, -0.199494890354002, -2.91619544314976, 1.1183754859348,
      -0.0720956352091243, 2.57688206830506, -1.87288550765454, 4.61215828572023,
      -13.9977653255434, 6.22827645222023, -4.73200693070627, 0.0511281448827857,
      -1.24520096947478, -0.486380743715951, -0.554439515530948, -1.85038445933004,
      -6.65473064862688, 1.41030669552872, 3.02338756065374, 3.20407706863677,
      -0.414999902101579, -27.6989310621504, -4.8894516627384, -45.2781775432445,
      -92.2463771933044, 7.352340223457, -1.10451523567172, -0.304384392866063,
      -2.79356815219835, 0.693327568145872, -0.174612991391082, 1.5362799852283,
      -1.37764113414053, 1.5359925618353, 0.222372941953216, -4.09853102874851,
      -9.74408325896182, 0.421924554484824, -1.67700665849156, -1.81054379529585,
      -0.544957875596668, 1.43242371273223, 1.4491321418307, -3.88723330075556,
      -0.33562971746793, -0.547330483724411, 2.33715958985861, 1.54663115391163,
      0.320722344226071, -1.62740655664067, 7.35234017338257, -46.6566729305279,
      0.0481281494284643, 0.00259473442154679, 0.291372727617933, -0.249310824853702,
      0.0755947664555668, 0.261690676434752, -0.550928089894223, 0.136467193738118,
      -6.72819264072683, 9.08993573020548, 15.0742238860626, -0.277360356376084,
      0.363150510877654, 0.451480290699602, 0.0338319134275641, 2.72876024934961,
      -0.0486634438813495, -0.0529949204912747, -3.324766976433, 1.3094561596068,
      -0.0841071466417022, -0.563276962864915, -0.124067721408209,
      -1.27782160157195, -1.10451520882962, 0.0481281577327523, -15.7020184071227,
      4.94457268007246, -22.4167749452375, 6.75555118416683, -0.885794912804348,
      1.37916472244872, -3.80411711512756, 0.908061155689571, -0.348874538419077,
      -0.545262166247165, 0.0950798535797559, 2.05515272481381, -11.0727824172681,
      0.610400682276098, -6.92575761174274, -0.619158946293136, -0.0362495964458806,
      -0.0806298810123318, 1.4960893294426, -0.621104345187727, 0.0416435496384468,
      -0.0992322187757995, 0.105485824244655, -0.199494903694018, -0.3043844018623,
      0.00259472643587738, 4.94457267039256, -18.367013136791, 1.26526660374414,
      -4.42738969972031, 1.97224678292423, 0.245373235540379, -0.411310654650664,
      0.611437638028518, 0.121310040648408, 0.0738824384283802, 0.0704447759157033,
      -3.54382836959451, 3.16671271171831, 2.75360789215521, -7.63087140574173,
      6.43980147299787, 0.120300918167775, -0.129295716272626, -8.47830693775797,
      3.10637361812827, -0.141241759185584, -1.29887004142591, -0.38519001727882,
      -2.91619536426877, -2.79356810084731, 0.291372737822217, -22.4167749464896,
      1.26526662295198, -49.9711488771461, 17.4992262062251, -1.60094646212603,
      2.74242919633597, -7.90239900430288, 1.29558657298799, -0.627450286533348,
      -1.44283388085322, 0.0669957164903268, 7.42444977852717, -26.8918077818307,
      -0.588192895309224, -7.88653782586273, -1.00041036445918, 2.42974191417447,
      -0.164924117535727, 3.64532258218675, -7.06812995106559, 0.599159638553167,
      0.404994229216658, -0.159043264110032, 1.11837560904941, 0.693327565366726,
      -0.249310979266158, 6.75555142417654, -4.42738981020723, 17.4992266354509,
      -51.5883897239484, 1.71549609996788, -0.315019513082665, 2.81321052186421,
      -1.0494967730705, -0.00712309646690738, 0.634197605527998, -0.246698154455737,
      0.189497151408122, 7.54266899610192, -0.56723971284849, -1.26706883565366,
      0.133577365701807, -0.044817213543914, 1.52578248259255, -0.396468496906113,
      0.482489025666541, -2.1789200078363, -0.114233097293513, -0.0338775025294717,
      -0.0720958022622028, -0.174612930888502, 0.0755948994395393,
      -0.885794910869529, 1.97224679049939, -1.6009464812426, 1.71549576971063,
      -18.8524765230162, 0.0573090978031133, -0.292308309122935, -0.19319120487855,
      -0.559361509634863, 0.272722576152638, 0.00884096008661864, 0.585380620636409,
      -2.03049663427775, -1.57603398514736, -0.77941853554339, 2.71505473810766,
      2.14595361476846, -1.20503446724789, -0.193508858691344, -1.09139338429892,
      0.404544527724104, 1.10421161500527, 0.0507317768158518, 2.57688257457111,
      1.53628026439384, 0.26169046433971, 1.37916481977209, 0.24537314140923,
      2.74242938432386, -0.315019581353898, 0.0573091673201777, -4.89733167165505,
      -2.16002660299793, -1.49764960721717, -3.31543944458369, -1.30693116112398,
      -0.204618144353061, -2.25017253472911, 0.636311324356297, -0.557368667682825,
      1.13595743274256, -2.09477488541603, -1.53472522077975, 0.859842959048592,
      8.13803797130815, 1.20916454638412, -0.978376153731058, -0.87882389076906,
      -0.426831447099869, -1.87288601223103, -1.37764081627752, -0.550924533742241,
      -3.80411423392768, -0.411312258032618, -7.902392878824, 2.81320660755763,
      -0.292305334399435, -2.16003805523396, 3.0017483666325, 7.61507533573921,
      2.57777591074364, 2.86924200487091, -0.718097467388691, 3.69688300553546,
      -2.20267107115443, 0.792303003718857, -2.62554180340843, 12.9436772374106,
      2.4935787027047, -0.50294357156134, -22.4945216013356, 1.92904403308881,
      0.833348371890325, 1.9620097311572, 0.0856550915523126, 4.61216070627006,
      1.53599176820759, 0.136467618727524, 0.908061218456042, 0.611437646602743,
      1.29558660269062, -1.04949702635767, -0.193190980842263, -1.49762709961594,
      7.6150704087759, -4.30810136868081, 1.29865092740854, 0.160011702859562,
      0.984479395570469, 1.51261028746982, 1.12724176415831, -0.917380890331817,
      1.9322932895103, -3.68488900664158, -0.891855516893696, 2.06804174094977,
      1.39752758064722, 0.471119627097935, -0.5530350969147, -3.70783387348435,
      8.82218485739892, -13.9977652415472, 0.222372594718045, -6.72819278009256,
      -0.348874543590232, 0.121310052014852, -0.627450311314523, -0.00712291505041626,
      -0.559361743105313, -3.31543795913656, 2.57777319856294, 1.29865336588021,
      -11.1232163786599, 12.299919112881, 18.1313471116129, -2.04157947307077,
      -1.17404907268521, -2.61960022969933, -0.0829668596741945, 2.0982773592975,
      0.727508393430942, -1.20384258409169, -1.79418434783368, -1.21305315316296,
      1.50717603856265, 0.195553543096791, -9.34941245197888, 6.22827642459889,
      -4.09853075827816, 9.0899363088062, -0.545262316128379, 0.0738825469134335,
      -1.44283422516361, 0.634197663792092, 0.272722621276084, -1.30693455330529,
      2.86924769526353, 0.160015348119239, 12.2999181635243, -15.1167667754893,
      -18.88506727372, -0.453892568923844, -2.7388468290611, 1.93463522722609,
      0.111727093553263, -1.04373751302586, 0.722295685403079, 0.144255315078523,
      0.926840605604645, 0.23624513763099, -0.438636445915616, -7.2221493507744,
      -22.3002348430607, -4.73200692996972, -9.744082929735, 15.0742239103675,
      0.0950799120906296, 0.0704447475780867, 0.0669958287297164, -0.246698234402241,
      0.00884101415768007, -0.204617518185681, -0.71809781796766, 0.984480220283097,
      18.1313475021458, -18.8850670276747, -43.8390573048292, 0.0318567662688484,
      0.102812774713482, -1.81228137554179, 0.104499438585137, -2.82028356674159,
      -1.41540383930284, -0.024027446397434, 3.16711914443715, 0.592050197858304,
      -0.0678933202131231, 0.0597140861127374, 0.270300841499187, 0.051128078335494,
      0.421924498188919, -0.277360321647226, 2.05515268144926, -3.54382833723402,
      7.42444972578953, 0.189497336924713, 0.585380189091872, -2.25017241099147,
      3.69688452572146, 1.51261122983579, -2.04157936388361, -0.453892288219982,
      0.0318567321404448, -18.8862013372396, 4.12439325552938, 2.49617216610786,
      0.152537272400905, 5.21689090650437, 1.30266497159524, -0.0304781077636731,
      -7.60082500346608, 0.869283100564958, -0.456363627025318, -0.554382533309083,
      -0.44445904457626, -1.24520120370075, -1.67700662804265, 0.363150527977219,
      -11.0727826928455, 3.16671290385449, -26.8918084307544, 7.54266930926276,
      -2.03049697567565, 0.63631211271671, -2.20267944351955, 1.1272411399467,
      -1.17404927721816, -2.73884672262102, 0.102812773883052, 4.12439345909446,
      -31.6082448377348, -2.77171118764714, -3.83096123951807, 0.753567210942441,
      0.180640572745343, -0.365487068080489, -1.10650396922298, -0.026799502357624,
      0.200561514405428, -0.132673365746916, -0.744525550147434, -0.486380812681615,
      -1.81054377595205, 0.451480314221452, 0.610400329279879, 2.75360806200832,
      -0.588193585968318, -0.567239452162934, -1.57603442644281, -0.557368859779824,
      0.792303196399753, -0.917380410608982, -2.61960014409552, 1.93463528174919,
      -1.81228134424161, 2.4961722349795, -2.77171188636525, -26.2337441092421,
      2.08434401598932, 0.135954653623526, -0.256782110989589, 0.0520493352415903,
      1.18445140706774, -0.117197244314036, -0.514304243653847, -0.258177942006875,
      0.118450495086264, -0.554439511348246, -0.544957881360768, 0.0338318944609468,
      -6.92575760130317, -7.63087140485224, -7.88653783094823, -1.26706880765732,
      -0.779418416506114, 1.13595754602447, -2.62554196990907, 1.93229308736522,
      -0.0829669395682638, 0.111726975775573, 0.104499449448465, 0.152537327927615,
      -3.83096126236615, 2.08434403618633, -30.2803476203132),
    .Dim = c(26L, 26L))

  sandwich_value <- mmcif_sandwich(
    cpp_obj, truth, ghq_data = ghq_data, n_threads = 2L)

  expect_equal(attr(sandwich_value, "hessian"), hess_log_compos,
               tolerance = 1e-4, ignore_attr = "dimnames")
  expect_snapshot_value(
    sandwich_value, style = "serialize", tolerance = 1e-5)
})

test_that("mmcif_fit gives the same as previously", {
  fit <- mmcif_fit(truth, cpp_obj, n_threads = 2L)
  expect_snapshot_value(
    fit[c("par", "value")], style = "serialize", tolerance = 1e-5)
})