inst/unitTests/runit.mcCalcCI.R

In mcr: Method Comparison Regression

cat("\n\nmcCalcCI.R method comparison test cases\n\n")

## check computation of analytical CIs

test.mc.analytical.mc.call <- function() 
{
    data(creatinine)
    crea <- creatinine[complete.cases(creatinine),]   
    
    tmp <- mcr:::mc.analytical.ci(b0=0.01504697, b1=0.99397124, se.b0=0.04339864, se.b1=0.03331363, n=108, alpha=.05)
    
    checkEquals(tmp[1,3:4], c(LCI=-0.07099505, UCI=0.101089), tolerance=10e-7)
    checkEquals(tmp[2,3:4], c(LCI=0.92792373, UCI=1.060019), tolerance=10e-7)
}

## check Linnet CIs

test.mc.calcLinnetCI.call <- function() 
{
    data(creatinine)
    crea <- creatinine[complete.cases(creatinine),]   
    crea <- crea[1:20,]
    
    Xjack.1 <- c(-0.036320907, -0.040834621, -0.035556748, -0.129454269, -0.032967966, 0.060481701, -0.023593350, -0.035586091, -0.036432444,
                 -0.037586340, -0.028744992, -0.040035388, -0.005368191, -0.017117064, -0.033902022, -0.029569894, -0.044316375, -0.031776970,
                 -0.050653545, -0.032787352)
         
    Xjack.2 <- c(0.9985335, 1.0086205, 0.9979571, 1.0444391, 0.9888404, 0.9181793, 0.9947117, 0.9979796, 1.0035050, 0.9990447, 0.9947252, 0.9996530,
                 0.9845641, 0.9902044, 0.9986472, 1.0038469, 1.0067244, 0.9921223, 1.0052475, 0.9968012)
         
    Xhat.1 <- -0.0351187
    Xhat.2 <- 0.9979441
    
    checkEquals( mcr:::mc.calcLinnetCI(Xjack.1, Xhat.1, alpha=.05), list(est=-0.0351187, se=0.13710168, CI=c(-0.3231586, 0.2529212)), tolerance=10e-7 )
    checkEquals( mcr:::mc.calcLinnetCI(Xjack.2, Xhat.2, alpha=.05), list(est=0.9979441, se=0.09327199, CI=c(0.8019870, 1.1939013)), tolerance=10e-7 )
}


## check bootstrap Student CIs

test.mc.calc.Student.call <- function()
{
    data(creatinine)
    crea <- creatinine[complete.cases(creatinine),]   
    crea <- crea[1:20,]
    
    bs.samples <- c(-0.0308092429914082, 0.160741834497271, 0.0869344769698916, -0.019058121928351, -0.141165649140443, 0.0302375687795815, -0.207924270160902,
                    0.0180427858196479, -0.0732640271517673, 0.226586474603168, -0.000755010720611793, -0.148396066547884, 0.0124672956195402, -0.0404645152570311, 
                    -0.0660229905250538, -0.141805964050193, 0.133609145612421, -0.108134518258264, -0.036694827658754, -0.18924395674076, -0.164732024590893, 
                    -0.00227256909159679, -0.0271928562371486, -0.119193146763311, -0.131424772890206, -0.176432633225917, 0.00551359629201009, -0.138899497405828, 
                    -0.00835997700052427, -0.039667089548975, 0.0414480274899649, -0.101673601088273, -0.00386371394500129, 0.0757692496642981, -0.143697127801927,
                    0.00671979857963234, -0.165193871547091, 0.0552957362653663, -0.0676654325117474, 0.19925658971328, -0.0277052765976693, 0.403736125063715, 
                    0.0313487435145661, 0.015443308207266, -0.1884968370014, -0.13513098108594, -0.0726777071568483, 0.0428615046139953, -0.0222832439191631, 
                    -0.0579987907863051, -0.115347657549894, 0.0222418895136531, 0.081966071214483, -0.05608139388968, -0.0806916796735204, -0.183404658815715, 
                    -0.122358448624797, -0.0471983034326073, -0.0176890250428099, 0.0788586915965335, -0.0636607590968479, -0.0491139084346794, -0.0116640522058467, 
                    -0.0196318178254389, -0.153615473996005, -0.117022820502525, -0.171960512686743, 0.044852488144473, -0.139568540745421, -0.122012965977388, 
                    0.0765525355074239, 0.151610625459017, -0.00862826041293485, -0.146991021708509, 0.0554725286681521, -0.00817357572950339, -0.113833661247456, 
                    6.23047777525976e-06, -0.005156413436751, -0.0443811417848976, -0.010011055991304, -0.0168360073104461, -0.0611582587161059, -0.0441073772888749,
                    0.0281397544378055, -0.0735415331291702, -0.121102356082873, -0.164243828542252, 0.0333461142371874, 0.0968424855935075, 0.00263194268001565, 
                    0.0183497175754954, 0.0715982878954569, 0.0663284939218933, -0.0554351791952374, 0.0363096774193545, -0.153381945534007, 0.0290512481632292, 
                    -0.126404535599309, -0.0526528804682695, 0.122319439644748, -0.0757199862717173, 0.211016347603666, -0.0188165625475529, -0.175999406422132, 
                    0.177554698717835, 0.103200979968161, 0.0750209617501003, 0.00737915926005117, -0.0306110231815653, -0.0536860905215386, -0.0236853669752561, 
                    -0.0703867727092955, -0.133626102905779, 0.119974727012859, -0.0355821920979285, -0.107333371641959, -0.0325707612326387, -0.271135354339523, 
                    0.0548621057411514, -0.0465801910617196, 0.147729699609581, 0.354107391638244, 0.0667012020933866, -0.0243316146737971, -0.0858534716281731, 
                    0.13851518558762, 0.0553274899823375, -0.0879040074224748, 0.085771554091161, 0.162289440536748, -0.075846331449295, -0.00439853779656518, 
                    0.0219275405136614, -0.0351352173975554, -0.0717085337609136, -0.0292055871139636, 0.135214744275625, 0.0429524070230825, -0.194796004540486, 
                    -0.105205941434744, -0.010586196374222, 0.047319355192549, -0.193844203642569, -0.163810875695084, -0.137004177125127, -0.0559524198353647, 
                    -0.105803159111981, -0.0627661586120927, -0.00241874436321865, -0.0661761578940889, -0.0147180936557536, -0.0317748535403946, -0.0809467983971985,
                    -0.0176591094638443, -0.0818738007721289, -0.169447146847232, -0.160634509304082, 0.169191376044973, 0.0940532750079659, 0.172319078248804, 
                    -0.155175678545822, -0.14424806909745, 0.316880194977515, -0.075587335525086, -0.045893448828598, 0.0231265369224978, -0.0235727442778828, 
                    0.0400460350546838, 0.256172331011107, -0.00984982284001235, -0.0225337116976925, -0.149015664622992, -0.0829030433370295, -0.00693503735305812,
                    -0.115430479161333, 0.105270233998924, -0.10238003519238, -0.0567475916424083, -0.0836304795843859, 0.0531101618453176, 0.0135228988221607, 
                    -0.0309702083828527, 0.0223069632749762, -0.0241029844515277, -0.12062681318609, 0.102820213621994, 0.370809523809526, 0.141499420868198, 
                    0.117219897563513, 0.0547788436331529, -0.0108178292859578, -0.0588374492688353, -0.123015537227153, 0.0441276054624851, 0.0831062664212079, 
                    0.00844020875469464, -0.0776928498323848, -0.0290428174889201, 0.00317401599720712, -0.0102872645379271, 0.194448655584456, -0.123237852677536, 
                    -0.160737055353196, -0.0533236670607118, 0.151443166928582, 0.0110361639407277, -0.0691950710552214, 0.248097803756697, -0.200799609265978, 
                    0.0252126857261716, -0.0928744183026222, -0.00504887737083748, 0.0288262258373617, 0.057204653001621, -0.189132296497132, 0.00729210342036124, 
                    -0.122666399041608, 0.259655959114795, -0.0563515677640154, 0.408342158100976, -0.154572416520996, -0.0986666001067948, -0.0451296520049611 )
                    
    res <- mcr:::mc.calc.Student( bs.samples, xhat=-0.0351187007883316, alpha=.05, npoints=20)
    
    checkEquals( res, list(est=-0.0351187007883316, se=0.115378419917883, CI=c(-0.277519766161998, 0.207282364585335)), tolerance=10e-7)
}

## check tBoot CIs

test.mc.calc.tboot.call <- function()
{
   
    B0.samples <- c(-0.0261944158606022, -0.081450120573622, -0.181802313393801, 0.172640081436766, 0.025144451506941, -0.137712498226508, 0.274534280267486,
                    0.104380203126685, -0.00368817901934193, -0.195021175576296, -0.0853757666129071, -0.123414931931501, 0.13495229909755, -0.133017611599229,
                    -0.128802526801625, 0.0275089228122993, -0.134946954159375, -0.0154922915206726, 0.153835862515078, 0.198007444318806, 0.0819330993802732,
                    -0.00488000154181645, -0.018946011213582, 0.0148453233629147, -0.0924417166116467, -0.0956961454741985, 0.302093956072268, -0.127148552109475,
                    0.0926747061441826, -0.0414997038353322, 0.34388533261151, -0.0523436012295391, -0.107690254275632, 0.28443896345723, 0.264502436608116,
                    -0.0477675183229012, 0.0878739834031323, 0.268983427335824, 0.0603415103172005, -0.00580061456367709, -0.109796145240564, 0.0889673942850913,
                    -0.150280762854567, 0.0120168218014174, -0.107218131785763, -0.181289465843909, 0.113195736012605, -0.152691911906173, -0.157122489209217,
                    0.167294153419436 )
        
    se.B0.samples <- c( 0.0930757479094717, 0.0737551418718934, 0.0672920000356185, 0.122887367264634, 0.0994669340134063, 0.0745277773476777, 0.154016351263478,
                        0.118468135690292, 0.122669150958229, 0.0570498416451958, 0.103764442792538, 0.0706041749660943, 0.16593039093416, 0.0515537821540748,
                        0.0894973723258305, 0.0732505087034265, 0.0825152027576689, 0.100574351974096, 0.115574163695755, 0.181864483100575, 0.0947992992631416,
                        0.119638446052207, 0.0646278026978218, 0.111808306493562, 0.120868567214021, 0.0875892321578167, 0.172610836261223, 0.04987945404237, 
                        0.103699075815571, 0.0951150011408919, 0.1166315506662, 0.0995573704391201, 0.0916279951996791, 0.162695947438828, 0.151102355942837,
                        0.0935054523396236, 0.117654931837663, 0.132094910095768, 0.102047471380023, 0.118724011504333, 0.0891503283399716, 0.122186349456141, 
                        0.0692557384936932, 0.106959664943787, 0.0980651104460597, 0.0774948769757688, 0.113910081538005, 0.0620450467770012, 0.0695550283685146,
                        0.134965305973953 )
            
    B0.glob <- -0.0351
    se.B0.glob <- 0.0987
    
    res <- mcr:::mc.calc.tboot( Xboot=B0.samples, Sboot=se.B0.samples, xhat=B0.glob, shat=se.B0.glob, alpha=.05)
    
    checkEquals( res, list(est=-0.0351, se=0.0987, CI=c("97.5%"=-0.2558322, "2.5%"=0.1738395)), tolerance=10e-7 )
}

## check BCa CIs

test.mc.calc.bca.call <- function()
{
    B0.samples <- c(-0.0261944158606022, -0.081450120573622, -0.181802313393801, 0.172640081436766, 0.025144451506941, -0.137712498226508, 0.274534280267486,
                    0.104380203126685, -0.00368817901934193, -0.195021175576296, -0.0853757666129071, -0.123414931931501, 0.13495229909755, -0.133017611599229,
                    -0.128802526801625, 0.0275089228122993, -0.134946954159375, -0.0154922915206726, 0.153835862515078, 0.198007444318806, 0.0819330993802732,
                    -0.00488000154181645, -0.018946011213582, 0.0148453233629147, -0.0924417166116467, -0.0956961454741985, 0.302093956072268, -0.127148552109475,
                    0.0926747061441826, -0.0414997038353322, 0.34388533261151, -0.0523436012295391, -0.107690254275632, 0.28443896345723, 0.264502436608116,
                    -0.0477675183229012, 0.0878739834031323, 0.268983427335824, 0.0603415103172005, -0.00580061456367709, -0.109796145240564, 0.0889673942850913,
                    -0.150280762854567, 0.0120168218014174, -0.107218131785763, -0.181289465843909, 0.113195736012605, -0.152691911906173, -0.157122489209217,
                    0.167294153419436 )
    
    B0.jack <- c( -0.036320907, -0.040834621, -0.035556748, -0.129454269, -0.032967966, 0.060481701, -0.023593350, -0.035586091, -0.036432444, -0.037586340, -0.028744992, -0.040035388,
                  -0.005368191, -0.017117064, -0.033902022, -0.029569894, -0.044316375, -0.031776970, -0.050653545, -0.032787352 )
    
    B0.glob <- -0.0351
    
    res <- mcr:::mc.calc.bca( Xboot=B0.samples, Xjack=B0.jack, xhat=B0.glob, alpha=.05 )
    
    checkEquals(as.numeric(res$CI), c(-0.1870422, 0.2811705), tolerance=10e-7)
}

## check Bootstrap-Student CIs

test.mc.calc.quantile <- function(Xboot, alpha) 
{
    samples <- c(-0.0261944158606022, -0.081450120573622, -0.181802313393801, 0.172640081436766, 0.025144451506941, -0.137712498226508, 0.274534280267486,
                    0.104380203126685, -0.00368817901934193, -0.195021175576296, -0.0853757666129071, -0.123414931931501, 0.13495229909755, -0.133017611599229,
                    -0.128802526801625, 0.0275089228122993, -0.134946954159375, -0.0154922915206726, 0.153835862515078, 0.198007444318806, 0.0819330993802732,
                    -0.00488000154181645, -0.018946011213582, 0.0148453233629147, -0.0924417166116467, -0.0956961454741985, 0.302093956072268, -0.127148552109475,
                    0.0926747061441826, -0.0414997038353322, 0.34388533261151, -0.0523436012295391, -0.107690254275632, 0.28443896345723, 0.264502436608116,
                    -0.0477675183229012, 0.0878739834031323, 0.268983427335824, 0.0603415103172005, -0.00580061456367709, -0.109796145240564, 0.0889673942850913,
                    -0.150280762854567, 0.0120168218014174, -0.107218131785763, -0.181289465843909, 0.113195736012605, -0.152691911906173, -0.157122489209217,
                    0.167294153419436 )
    
    res <- mcr:::mc.calc.quantile(Xboot=samples, alpha=.05)
    
    checkEquals(res, list(est=c("50%"=-0.01064645), CI=c("2.5%"=-0.1816869, "97.5%"=0.2981216)), tolerance=10e-7) 
}

test.mc.make.CIframe.call <- function()
{    
    res <- mcr:::mc.make.CIframe(b0=1, b1=2, se.b0=3, se.b1=4, CI.b0=c(5,5), CI.b1=c(6,6))
    checkEquals( colnames(res), c("EST", "SE", "LCI", "UCI"))
    checkEquals( rownames(res), c("Intercept", "Slope"))
}