tests/testthat/test-association-mipred.R

In mipred: Prediction using Multiple Imputation

context

skip('association tests mipred')

cll <- readRDS("CLL_BMJ.rds")

cll_bin<-cll

cll_bin$srv5y_s[cll_bin$srv5y>12] <- 0  # Apply an administrative censorship at t=84 months
cll_bin$srv5y[cll_bin$srv5y>12]  <- 12

cll_bin$Status[cll_bin$srv5y_s==1]<- 1  # Define the "Status" variable
cll_bin$Status[cll_bin$srv5y_s==0] <- 0  # Ss numeric -> 1:Dead, 0:Alive

cll_bin$Censor <- NULL
cll_bin$srv5y <- NULL
cll_bin$srv5y_s <- NULL

# based on: nimp=2, folds=1, mice.options=list(maxit=2, seed=seed) and seeds as below
preds <- c(`501` = 0.337892403615733, `502` = 0.199204773668111, `503` = 0.218412867793947,
  `504` = 0.218412867793947, `505` = 0.202693121901883, `506` = 0.523739534650995,
  `507` = 0.254784401481653, `508` = 0.681652348435668, `509` = 0.294066576650516,
  `510` = 0.218412867793947, `511` = 0.328714671507064, `512` = 0.364688512734622,
  `513` = 0.401880948501623, `514` = 0.237002383887036, `515` = 0.464917058758382,
  `516` = 0.222474476710584, `517` = 0.183754603682255, `518` = 0.31626535845622,
  `519` = 0.199204773668111, `520` = 0.205968139869823, `521` = 0.392065966118855,
  `522` = 0.205990744773723, `523` = 0.306573081942351, `524` = 0.483666763720224,
  `525` = 0.190295902854101, `526` = 0.218412867793947, `527` = 0.215562438621811,
  `528` = 0.362660780536843, `529` = 0.377091358321162, `530` = 0.331697665554046,
  `531` = 0.477881574192223, `532` = 0.363098323102475, `533` = 0.284165529116623,
  `534` = 0.474639755290425, `535` = 0.353375706533601, `536` = 0.403775041466008,
  `537` = 0.199204773668111, `538` = 0.355123987639394, `539` = 0.331697665554046,
  `540` = 0.478317387111701, `541` = 0.395297192480154, `542` = 0.285754102090552,
  `543` = 0.183754603682255, `544` = 0.213132186738686, `545` = 0.493911957197199,
  `546` = 0.356075206502495, `547` = 0.218412867793947, `548` = 0.217682682156021,
  `549` = 0.440421621790228, `550` = 0.203606190582561, `551` = 0.656126840659109,
  `552` = 0.281519586307866, `553` = 0.218412867793947, `554` = 0.367144972908225,
  `555` = 0.493911957197199, `556` = 0.359436287275444, `557` = 0.493911957197199,
  `558` = 0.205968139869823, `559` = 0.307270432606224, `560` = 0.199204773668111,
  `561` = 0.355123987639394, `562` = 0.392065966118855, `563` = 0.285754102090552,
  `564` = 0.307270432606224, `565` = 0.477301719514547, `566` = 0.264901732209146,
  `567` = 0.211869094970696, `568` = 0.199204773668111, `569` = 0.190295902854101,
  `570` = 0.225756302687763, `571` = 0.246984013129621, `572` = 0.347493690030658,
  `573` = 0.199204773668111, `574` = 0.199204773668111, `575` = 0.34030801030265,
  `576` = 0.218412867793947, `577` = 0.31626535845622, `578` = 0.31626535845622,
  `579` = 0.199204773668111, `580` = 0.392065966118855, `581` = 0.354309850291299,
  `582` = 0.199204773668111, `583` = 0.199204773668111, `584` = 0.199204773668111,
  `585` = 0.205968139869823, `586` = 0.328714671507064, `587` = 0.392065966118855,
  `588` = 0.190295902854101, `589` = 0.331697665554046, `590` = 0.212249398109364,
  `591` = 0.202864691044858, `592` = 0.464917058758382, `593` = 0.483364686871897,
  `594` = 0.47633545217195, `595` = 0.328714671507064, `596` = 0.341782719215383,
  `597` = 0.307270432606224, `598` = 0.225756302687763, `599` = 0.243348435284038,
  `600` = 0.499682095060102, `601` = 0.209935699933201, `602` = 0.26231939975784,
  `603` = 0.331697665554046, `604` = 0.218412867793947, `605` = 0.199204773668111,
  `606` = 0.367723491499016, `607` = 0.232958826284993, `608` = 0.331697665554046,
  `609` = 0.231085498366031, `610` = 0.240094165818287, `611` = 0.20991038602388,
  `612` = 0.683703807912175, `613` = 0.355123987639394, `614` = 0.220042393933987,
  `615` = 0.276270511377793, `616` = 0.493911957197199, `617` = 0.400207433530579,
  `618` = 0.337021694954066, `619` = 0.32784817878615, `620` = 0.328714671507064,
  `621` = 0.31626535845622, `622` = 0.208380951451056, `623` = 0.31626535845622,
  `624` = 0.68719067482786, `625` = 0.225756302687763, `626` = 0.205968139869823,
  `627` = 0.683703807912175, `628` = 0.222474476710584, `629` = 0.211889230755208,
  `630` = 0.31626535845622, `631` = 0.355123987639394, `632` = 0.707448793139468,
  `633` = 0.218412867793947, `634` = 0.205968139869823, `635` = 0.212508001880656,
  `636` = 0.328714671507064, `637` = 0.246984013129621, `638` = 0.251601411808525,
  `639` = 0.355123987639394, `640` = 0.250650523345485, `641` = 0.26231939975784,
  `642` = 0.244992920651384, `643` = 0.335147052200113, `644` = 0.190295902854101,
  `645` = 0.31626535845622, `646` = 0.183754603682255, `647` = 0.199204773668111,
  `648` = 0.218412867793947, `649` = 0.20400354790204, `650` = 0.364688512734622,
  `651` = 0.317205348366775, `652` = 0.412561379717672, `653` = 0.215562438621811,
  `654` = 0.240094165818287, `655` = 0.355123987639394, `656` = 0.246984013129621,
  `657` = 0.205968139869823, `658` = 0.218412867793947, `659` = 0.34785511085403,
  `660` = 0.218412867793947, `661` = 0.199204773668111, `662` = 0.218412867793947,
  `663` = 0.294066576650516, `664` = 0.344660320824448, `665` = 0.199204773668111,
  `666` = 0.368992492197088, `667` = 0.190295902854101, `668` = 0.331697665554046,
  `669` = 0.285754102090552, `670` = 0.68122526342994, `671` = 0.427170500177005,
  `672` = 0.2106131662747, `673` = 0.183754603682255, `674` = 0.532906918361482,
  `675` = 0.286940067632313, `676` = 0.215562438621811, `677` = 0.427486280663897,
  `678` = 0.367723491499016, `679` = 0.207970943296598, `680` = 0.328714671507064,
  `681` = 0.25461753180464, `682` = 0.392065966118855, `683` = 0.285908136027737,
  `684` = 0.303428782739412, `685` = 0.493911957197199, `686` = 0.199204773668111,
  `687` = 0.205968139869823, `688` = 0.493911957197199, `689` = 0.337892403615733,
  `690` = 0.225756302687763, `691` = 0.225408009884078, `692` = 0.244588873175406,
  `693` = 0.190295902854101, `694` = 0.276261987583769)

seeds <- c(7350, 5880, 2571, 3887, 9745, 5608, 3468, 2711, 3448, 4676,
  1627, 5087, 6479, 3901, 1037, 6622, 4832, 3382, 8515, 268, 3210,
  5944, 3380, 3646, 9188, 2750, 7987, 466, 2981, 136, 5134, 8476,
  5618, 8948, 1590, 5281, 2551, 2052, 1444, 8688, 1691, 6398, 4728,
  8267, 5274, 4154, 982, 7540, 3081, 5286, 6405, 1238, 5589, 8221,
  6026, 1922, 7651, 3100, 4341, 2134, 9685, 4524, 9750, 7618, 8211,
  2438, 824, 6982, 6548, 9743, 4302, 9038, 185, 4418, 1306, 6643,
  9865, 3436, 6151, 9647, 4261, 8109, 7573, 127, 571, 4545, 7245,
  4764, 5038, 9037, 6085, 1459, 5124, 9463, 942, 2241, 6492, 3190,
  8229, 7099)
seed <- as.vector(matrix(seeds,ncol=1))
set.seed(12345)
# output<-mipred(Status~perfstat+remstat+cyto,family=binomial(link="logit"),data=cll_bin[1:500,-1],newdata=cll_bin[501:694,c(-1,-10)], nimp=500, folds=1, mice.options=list(maxit=10, seed=seed))

output<-mipred(Status~perfstat+remstat+cyto,family=binomial(link="logit"),data=cll_bin[1:500,-1],newdata=cll_bin[501:694,c(-1,-10)], nimp=2, folds=1, mice.options=list(maxit=2, seed=seed))
# dput(cor(apply(output$pred,1,mean),preds))
# 0.979144406319983

test_that("predictions replicated from saved results for averaging approach",{
  expect_true(abs(cor(apply(output$pred,1,mean),preds)-0.979144406319983)<1e-13)
})

# based on: nimp=2, folds=1, mice.options=list(maxit=2, seed=seed) and seeds as below
preds <- c(`501` = 0.339830352761587, `502` = 0.198057453004595, `503` = 0.219717687026288,
  `504` = 0.219717687026288, `505` = 0.201932152862984, `506` = 0.516580002477286,
  `507` = 0.252299762344468, `508` = 0.679195248458753, `509` = 0.289943023410268,
  `510` = 0.219717687026288, `511` = 0.328218710752526, `512` = 0.369844769205861,
  `513` = 0.400313973243862, `514` = 0.238147322272663, `515` = 0.46370334184322,
  `516` = 0.222815538488556, `517` = 0.183582868269006, `518` = 0.319117636043218,
  `519` = 0.198057453004595, `520` = 0.206479623386643, `521` = 0.387849834078682,
  `522` = 0.204846813195814, `523` = 0.304138035486609, `524` = 0.476187559397158,
  `525` = 0.191536533366097, `526` = 0.219717687026288, `527` = 0.213906657439661,
  `528` = 0.35711680169509, `529` = 0.376183616568691, `530` = 0.332588201710895,
  `531` = 0.475855036933524, `532` = 0.356378828979135, `533` = 0.272598211292523,
  `534` = 0.48266239417483, `535` = 0.363619006361361, `536` = 0.424347666255493,
  `537` = 0.198057453004595, `538` = 0.357763344885025, `539` = 0.332588201710895,
  `540` = 0.478787634882513, `541` = 0.397781761767187, `542` = 0.284662724260871,
  `543` = 0.183582868269006, `544` = 0.215986536691598, `545` = 0.49643131661121,
  `546` = 0.37896424325688, `547` = 0.219717687026288, `548` = 0.211957659892507,
  `549` = 0.440478106449738, `550` = 0.203140915960887, `551` = 0.647575317222501,
  `552` = 0.273052849159813, `553` = 0.219717687026288, `554` = 0.356291500146627,
  `555` = 0.49643131661121, `556` = 0.358310469581252, `557` = 0.49643131661121,
  `558` = 0.206479623386643, `559` = 0.307883660437639, `560` = 0.198057453004595,
  `561` = 0.357763344885025, `562` = 0.387849834078682, `563` = 0.284662724260871,
  `564` = 0.307883660437639, `565` = 0.474524790710876, `566` = 0.262118592720757,
  `567` = 0.210996162757117, `568` = 0.198057453004595, `569` = 0.191536533366097,
  `570` = 0.228798146677834, `571` = 0.242579965268051, `572` = 0.342638120327859,
  `573` = 0.198057453004595, `574` = 0.198057453004595, `575` = 0.340999425685368,
  `576` = 0.219717687026288, `577` = 0.319117636043218, `578` = 0.319117636043218,
  `579` = 0.198057453004595, `580` = 0.387849834078682, `581` = 0.35021417335255,
  `582` = 0.198057453004595, `583` = 0.198057453004595, `584` = 0.198057453004595,
  `585` = 0.206479623386643, `586` = 0.328218710752526, `587` = 0.387849834078682,
  `588` = 0.191536533366097, `589` = 0.332588201710895, `590` = 0.210016239151203,
  `591` = 0.20765266487272, `592` = 0.46370334184322, `593` = 0.472900879471191,
  `594` = 0.474662948671234, `595` = 0.328218710752526, `596` = 0.339044560452697,
  `597` = 0.307883660437639, `598` = 0.228798146677834, `599` = 0.245592159959199,
  `600` = 0.491096771255341, `601` = 0.210418887635221, `602` = 0.264173837283813,
  `603` = 0.332588201710895, `604` = 0.219717687026288, `605` = 0.198057453004595,
  `606` = 0.361750068040188, `607` = 0.23009827730746, `608` = 0.332588201710895,
  `609` = 0.233195788797959, `610` = 0.239476077954899, `611` = 0.212547470220355,
  `612` = 0.677081118171663, `613` = 0.357763344885025, `614` = 0.213566492422749,
  `615` = 0.262557559802023, `616` = 0.49643131661121, `617` = 0.407207706328786,
  `618` = 0.338424015892988, `619` = 0.325035510772782, `620` = 0.328218710752526,
  `621` = 0.319117636043218, `622` = 0.208889928529488, `623` = 0.319117636043218,
  `624` = 0.6824637406365, `625` = 0.228798146677834, `626` = 0.206479623386643,
  `627` = 0.677081118171663, `628` = 0.222815538488556, `629` = 0.218899986298814,
  `630` = 0.319117636043218, `631` = 0.357763344885025, `632` = 0.705069664327123,
  `633` = 0.219717687026288, `634` = 0.206479623386643, `635` = 0.214970072428321,
  `636` = 0.328218710752526, `637` = 0.242579965268051, `638` = 0.242518549387408,
  `639` = 0.357763344885025, `640` = 0.257287364387135, `641` = 0.264173837283813,
  `642` = 0.251180234597738, `643` = 0.345621612550369, `644` = 0.191536533366097,
  `645` = 0.319117636043218, `646` = 0.183582868269006, `647` = 0.198057453004595,
  `648` = 0.219717687026288, `649` = 0.203003663730659, `650` = 0.369844769205861,
  `651` = 0.314489778295301, `652` = 0.395697806769928, `653` = 0.213906657439661,
  `654` = 0.239476077954899, `655` = 0.357763344885025, `656` = 0.242579965268051,
  `657` = 0.206479623386643, `658` = 0.219717687026288, `659` = 0.345732660276291,
  `660` = 0.219717687026288, `661` = 0.198057453004595, `662` = 0.219717687026288,
  `663` = 0.289943023410268, `664` = 0.345058128135232, `665` = 0.198057453004595,
  `666` = 0.368379272195071, `667` = 0.191536533366097, `668` = 0.332588201710895,
  `669` = 0.284662724260871, `670` = 0.676534466128386, `671` = 0.427639232775389,
  `672` = 0.210626768243556, `673` = 0.183582868269006, `674` = 0.528581502525601,
  `675` = 0.292652979428757, `676` = 0.213906657439661, `677` = 0.428214807366272,
  `678` = 0.361750068040188, `679` = 0.208733453728983, `680` = 0.328218710752526,
  `681` = 0.254152085257057, `682` = 0.387849834078682, `683` = 0.279314771189554,
  `684` = 0.308170208354362, `685` = 0.49643131661121, `686` = 0.198057453004595,
  `687` = 0.206479623386643, `688` = 0.49643131661121, `689` = 0.339830352761587,
  `690` = 0.228798146677834, `691` = 0.218005460187724, `692` = 0.252128165069915,
  `693` = 0.191536533366097, `694` = 0.263386262052196)

seed <- as.vector(matrix(seeds,ncol=1))
set.seed(12345)
output<-mipred(Status~perfstat+remstat+cyto,family=binomial(link="logit"),data=cll_bin[1:500,-1],newdata=cll_bin[501:694,c(-1,-10)], nimp=2, folds=1, mice.options=list(maxit=2, seed=seed), method="rubin")
# dput(cor(apply(output$pred,1,mean),preds))
# 0.959588155141541

test_that("predictions replicated from saved results for rubin approach",{
  expect_true(abs(cor(apply(output$pred,1,mean),preds)-0.959588155141541)<1e-13)
})



seeds <- c(7350, 5880, 2571, 3887, 9745, 5608, 3468, 2711, 3448, 4676,
  1627, 5087, 6479, 3901, 1037, 6622, 4832, 3382, 8515, 268, 3210,
  5944, 3380, 3646, 9188, 2750, 7987, 466, 2981, 136, 5134, 8476,
  5618, 8948, 1590, 5281, 2551, 2052, 1444, 8688, 1691, 6398, 4728,
  8267, 5274, 4154, 982, 7540, 3081, 5286, 6405, 1238, 5589, 8221,
  6026, 1922, 7651, 3100, 4341, 2134, 9685, 4524, 9750, 7618, 8211,
  2438, 824, 6982, 6548, 9743, 4302, 9038, 185, 4418, 1306, 6643,
  9865, 3436, 6151, 9647, 4261, 8109, 7573, 127, 571, 4545, 7245,
  4764, 5038, 9037, 6085, 1459, 5124, 9463, 942, 2241, 6492, 3190,
  8229, 7099)

output <- list(pred = structure(c(0.272822624187677, 0.26335349393881,
  0.245055602778557, 0.316090037563377, 0.313007499662245, 0.297912651367598,
  0.307891918762763, 0.255163876316593, 0.331122267440826, 0.364964866709756
), .Dim = c(5L, 2L), .Dimnames = list(c("501", "502", "503",
  "504", "505"), NULL)), linpred = structure(c(-0.980348575240286,
    -1.02861092500769, -1.1251589655607, -0.771799173093083, -0.786096224788477,
    -0.857257497214206, -0.809993321899551, -1.07125823500496, -0.703113586720463,
    -0.553879232018371), .Dim = c(5L, 2L), .Dimnames = list(c("501",
      "502", "503", "504", "505"), NULL)))

mice.options <- NULL
mice.options$seed <- as.vector(matrix(seeds,ncol=1,nrow=5*5))[1:4]
mice.options$maxit <- 2

set.seed(12345)
test_that("output replicates saved results from specified seed for mipred and averaging method",{
  expect_equal(mipred(Status~age10+cyto,family=binomial,data=cll_bin[1:500,-1],newdata=cll_bin[501:505,c(-1,-10)], nimp=2, folds=2, mice.options=mice.options)[2:3],output)
    })

output <- list(pred = structure(c(0.313619237134538, 0.287549302953276,
  0.243573611866073, 0.313856654363961, 0.278459046089519, 0.313619237134538,
  0.287549302953276, 0.243573611866073, 0.313856654363961, 0.324948659032894
), .Dim = c(5L, 2L), .Dimnames = list(c("501", "502", "503",
  "504", "505"), NULL)), linpred = structure(c(-0.783252892154253,
    -0.907316378553107, -1.13318601836123, -0.782150197640975, -0.952118141968731,
    -0.783252892154253, -0.907316378553107, -1.13318601836123, -0.782150197640975,
    -0.731121551027735), .Dim = c(5L, 2L), .Dimnames = list(c("501",
      "502", "503", "504", "505"), NULL)))

mice.options <- NULL
mice.options$seed <- as.vector(matrix(seeds,ncol=1,nrow=5*5))[1:2]
mice.options$maxit <- 2

set.seed(12345)

outputnew <- mipred(Status~age10+cyto,family=binomial,data=cll_bin[1:500,-1],newdata=cll_bin[501:505,c(-1,-10)], nimp=2, folds=2, mice.options=mice.options, method="rubin")[2:3]
test_that("output replicates saved results from specified seed for mipred and rubin method",{
  expect_equal(outputnew,output)
})



# check use of "." notation inside formula for averaging method
# by comparing output between two distinct analyses
seeds <- c(7350, 5880, 2571, 3887, 9745, 5608, 3468, 2711, 3448, 4676,
  1627, 5087, 6479, 3901, 1037, 6622, 4832, 3382, 8515, 268, 3210,
  5944, 3380, 3646, 9188, 2750, 7987, 466, 2981, 136, 5134, 8476,
  5618, 8948, 1590, 5281, 2551, 2052, 1444, 8688, 1691, 6398, 4728,
  8267, 5274, 4154, 982, 7540, 3081, 5286, 6405, 1238, 5589, 8221,
  6026, 1922, 7651, 3100, 4341, 2134, 9685, 4524, 9750, 7618, 8211,
  2438, 824, 6982, 6548, 9743, 4302, 9038, 185, 4418, 1306, 6643,
  9865, 3436, 6151, 9647, 4261, 8109, 7573, 127, 571, 4545, 7245,
  4764, 5038, 9037, 6085, 1459, 5124, 9463, 942, 2241, 6492, 3190,
  8229, 7099)+999
seed <- as.vector(matrix(seeds,ncol=1,nrow=5*5))[1:4]
set.seed(43251)
output1<-mipred(Status~.,family=binomial,data=cll_bin[1:500,-1],newdata=cll_bin[501:694,c(-1,-10)], nimp=2, folds=2, mice.options=list(maxit=2, printFlag=FALSE, seed=seed))
set.seed(43251)
output2<-mipred(Status~age10+perfstat+remstat+cyto+asct+donor+sex_match+cond,family=binomial,data=cll_bin[1:500,-1],newdata=cll_bin[501:694,c(-1,-10)], nimp=2, folds=2, mice.options=list(maxit=2, printFlag=FALSE, seed=seed))

test_that("mipred results correct when using dot notation in predictor for averaging method",{
  expect_identical(output1[2:3],output2[2:3])
})



# check use of "." notation inside formula for rubin method
# by comparing output between two distinct analyses
seeds <- c(7350, 5880, 2571, 3887, 9745, 5608, 3468, 2711, 3448, 4676,
  1627, 5087, 6479, 3901, 1037, 6622, 4832, 3382, 8515, 268, 3210,
  5944, 3380, 3646, 9188, 2750, 7987, 466, 2981, 136, 5134, 8476,
  5618, 8948, 1590, 5281, 2551, 2052, 1444, 8688, 1691, 6398, 4728,
  8267, 5274, 4154, 982, 7540, 3081, 5286, 6405, 1238, 5589, 8221,
  6026, 1922, 7651, 3100, 4341, 2134, 9685, 4524, 9750, 7618, 8211,
  2438, 824, 6982, 6548, 9743, 4302, 9038, 185, 4418, 1306, 6643,
  9865, 3436, 6151, 9647, 4261, 8109, 7573, 127, 571, 4545, 7245,
  4764, 5038, 9037, 6085, 1459, 5124, 9463, 942, 2241, 6492, 3190,
  8229, 7099)+1000
seed <- as.vector(matrix(seeds,ncol=1,nrow=5*5))[1:4]
set.seed(96471)
output1<-mipred(Status~.,family=binomial,data=cll_bin[1:500,-1],newdata=cll_bin[501:694,c(-1,-10)], nimp=2, folds=2, mice.options=list(maxit=2, printFlag=FALSE, seed=seed), method="rubin")
set.seed(96471)
output2<-mipred(Status~age10+perfstat+remstat+cyto+asct+donor+sex_match+cond,family=binomial,data=cll_bin[1:500,-1],newdata=cll_bin[501:694,c(-1,-10)], nimp=2, folds=2, mice.options=list(maxit=2, printFlag=FALSE, seed=seed), method="rubin")
test_that("mipred results correct when using dot notation in predictor for rubin method",{
  expect_identical(output1[2:3],output2[2:3])
})