tests/testthat/test-zelnik.R

In timriffe/DemoTools: Standardize, Evaluate, and Adjust Demographic Data

# Author: ilya
###############################################################################
context("test-zelnik")

# data from gray1987missingages, Table 2, page 21: Aplication of Q1 and
# Q2 linear operators, Bangladesh Census, 1 March 1974-Males.

test_that("zelnik works",{
    
    Pop <- c(941307, 1041335, 1237034, 1411359, 1383853, 1541942, 
             1321576, 1285877, 1563448, 886705, 1623998, 562924, 
             1485173, 543216, 771219, 903496, 686431, 370007, 
             942999, 250820, 1023667, 200131, 688640, 222011, 
             281738, 1239965, 288363, 263326, 483143, 78635,
             1349886, 68438, 415127, 101596, 100758, 1392434, 
             178633, 126351, 286520, 50836, 1331036, 48995, 
             251153, 58393, 54995, 1033812, 68792, 72766, 
             175943, 28254, 1038747, 32894, 136179, 37667, 
             38230, 596049, 52602, 36493, 74106, 16759,
             790643, 20596, 70109, 18044, 19891, 357491, 
             15253, 17489, 31057, 8481, 429816, 7951, 
             35583, 8612, 6589, 454645)
    
    Age  <- 0:75
    
    
    
    # a function required to make original table work
    perturb <- function(x, pert = 0, pos = 45){
        x[pos] <- x[pos] + pert
        return(x)
    }
    
    z1 <- zelnik(perturb(Pop, -40, 45), 1, Age)
    z2 <- zelnik(perturb(Pop, -40, 45), 2, Age)

    
    q1_answer <- c(rep(NA, 10), 1151172, 1077888, 982103, 891354,
                   828173, 762583, 718528, 649206, 579004, 535521, 552769, 572789,
                   543715, 504766, 456185, 484627, 516545, 487585, 458525, 437117,
                   442480, 456052, 440706, 415651, 400515, 403565, 409668, 402329,
                   391982, 392801, 362520, 327180, 322889, 318215, 316334, 296278,
                   276958, 275057, 272350, 279354, 244466, 209374, 214178, 210162,
                   208499, 191717, 173916, 173882, 172936, 176417, 158124, 138487,
                   141009, 142779, 145479, rep(NA, 11))
    
    q2_answer <- c(rep(NA, 15), 769826, 711733, 663995, 623069,
                   584797, 552352, 530538, 515578, 505073, 497808, 489977, 479740,
                   469326, 460446, 454699, 449240, 439744, 429856, 422980, 419200,
                   414487, 403537, 389871, 378716, 370274, 361289, 348796, 334849,
                   321901, 310028, 298308, 286242, 274796, 263983, 253143, 242464,
                   232007, 221636, 211372, 200807, 191057, 183573, 176971, 170539, 
                   164776, rep(NA, 16))

    
    expect_equivalent(
        z1[!is.na(z1)],
        q1_answer[!is.na(q1_answer)],
        tolerance = 1
    )
    
    expect_equivalent(
        z2[!is.na(z2)],
        q2_answer[!is.na(q2_answer)],
        tolerance = 1
    )
})