tests/testthat/test-account-functions.R

In ONSdigital/Bayesian-demographic-accounts: Bayesian Demographic Accounts

## to_increments_flow ---------------------------------------------------------

test_that("'to_increments_flow' works with valid inputs", {
    set.seed(0)
    deaths <- fake_classif_vars()
    deaths$count <- rpois(n = nrow(deaths), lambda = 10)
    ans_obtained <- to_increments_flow(df = deaths,
                                       nm_df = "deaths",
                                       entry = FALSE)
    ans_expected <- aggregate(deaths["count"],
                              deaths[c("cohort", "sex", "time")],
                              sum)
    ans_expected$deaths <- -1 * ans_expected$count
    ans_expected <- ans_expected[-match("count", names(ans_expected))]
    expect_equal(ans_obtained, ans_expected)
})

## to_increments_flows --------------------------------------------------------

test_that("'to_increments_flows' works with valid inputs", {
    set.seed(0)
    deaths <- fake_classif_vars()
    immigration <- fake_classif_vars()
    emigration <- fake_classif_vars()
    internal_in <- fake_classif_vars()
    internal_out <- fake_classif_vars()
    deaths$count <- rpois(n = nrow(deaths), lambda = 10)
    immigration$count <- rpois(n = nrow(immigration), lambda = 10)
    emigration$count <- rpois(n = nrow(emigration), lambda = 10)
    internal_in$count <- rpois(n = nrow(internal_in), lambda = 10)
    internal_out$count <- rpois(n = nrow(internal_out), lambda = 10)
    account <- list(deaths = deaths,
                    immigration = immigration,
                    emigration = emigration,
                    internal_in = internal_in,
                    internal_out = internal_out)
    ans_obtained <- to_increments_flows(account)
    l <- mapply(to_increments_flow,
                df = account,
                nm_df = names(account),
                entry = c(FALSE, TRUE, FALSE, TRUE, FALSE),
                SIMPLIFY = FALSE)
    ans_expected <- merge(l$deaths, l$immigration)
    ans_expected <- merge(ans_expected, l$emigration)
    ans_expected <- merge(ans_expected, l$internal_in)
    ans_expected <- merge(ans_expected, l$internal_out)
    expect_equal(ans_obtained, ans_expected)
})


## to_increments_stocks -------------------------------------------------------

test_that("'to_increments_stocks' works with valid inputs", {
    set.seed(0)
    population <- expand.grid(age = 0:5,
                              sex = c("F", "M"),
                              time = 2000:2003)
    population$count <- rpois(n = nrow(population), lambda = 50)
    births <- expand.grid(age = 2:3,
                          sex = c("F", "M"),
                          is_upper = c(FALSE, TRUE),
                          time = c(2001:2003))
    births$cohort <- births$time - births$age - births$is_upper
    births <- births[-match("is_upper", names(births))]
    births$count <- rpois(n = nrow(births), lambda = 10)
    account <- list(population = population,
                    births = births)
    ans_obtained <- to_increments_stock(account)
    stock1 <- within(population, {
        cohort <- time - age
    })
    stock1 <- stock1[-match("age", names(stock1))]
    stock2 <- within(births, {
        cohort <- time
        time <- time - 1L
    })
    stock2 <- aggregate(stock2["count"],
                        stock2[c("cohort", "sex", "time")],
                        sum)
    stock <- rbind(stock1, stock2)
    stock <- sort_classif_cols(stock, ignore = "count")
    stock <- sort_df(stock, ignore = "count")
    l <- split(stock[c("time", "count")],
               stock[c("cohort", "sex")],
               lex.order = TRUE)
    l <- lapply(l, function(x) {
        nrow <- nrow(x)
        new <- data.frame(time = x$time[[nrow]] + 1L, count = 0L);
        rbind(x, new)
    })
    l <- lapply(l, function(x) data.frame(time = x$time[-1L], stock = diff(x$count)))
    cohort <- as.integer(sapply(names(l), function(x) strsplit(x, split = ".", fixed = TRUE)[[1L]][[1L]]))
    dies <- cohort < max(population$time) - max(population$age)
    l[dies] <- lapply(l[dies], function(x) {x$drop <- FALSE; x})
    l[!dies] <- lapply(l[!dies], function(x) {n <- nrow(x); i <- seq_len(n); x$drop <- i == n; x})
    ans <- data.frame(stock[c("cohort", "sex")], do.call(rbind, l))
    ans <- ans[!ans$drop, ]
    ans <- ans[-match("drop", names(ans))]
    rownames(ans) <- NULL
    ans_expected <- sort_df(ans, ignore = "stock")
    expect_identical(ans_obtained, ans_expected)
    ## check totals
    incr_popn <- aggregate(population["count"],
                           population["time"],
                           sum)
    incr_popn <- diff(incr_popn$count)
    incr_births <- aggregate(births["count"],
                             births["time"],
                             sum)$count
    incr_stock <- aggregate(ans_obtained["stock"],
                            ans_obtained["time"],
                            sum)$stock
    expect_equal(incr_popn - incr_births, incr_stock)
})


## to_increments -------------------------------------------------------

test_that("'to_increments' works with valid inputs", {
    set.seed(0)
    population <- fake_classif_vars(n_time = 4L)
    population$time <- population$time - 1L
    population <- unique(population[-match("cohort", names(population))])
    births <- fake_classif_vars()
    births <- births[births$age == 1, , drop = FALSE]
    deaths <- fake_classif_vars()
    immigration <- fake_classif_vars()
    emigration <- fake_classif_vars()
    internal_in <- fake_classif_vars()
    internal_out <- fake_classif_vars()
    population$count <- rpois(n = nrow(population), lambda = 100)
    births$count <- rpois(n = nrow(births), lambda = 10)
    deaths$count <- rpois(n = nrow(deaths), lambda = 10)
    immigration$count <- rpois(n = nrow(immigration), lambda = 10)
    emigration$count <- rpois(n = nrow(emigration), lambda = 10)
    internal_in$count <- rpois(n = nrow(internal_in), lambda = 10)
    internal_out$count <- rpois(n = nrow(internal_out), lambda = 10)
    account <- list(population = population,
                    births = births,
                    deaths = deaths,
                    immigration = immigration,
                    emigration = emigration,
                    internal_in = internal_in,
                    internal_out = internal_out)
    ans <- to_increments(account)
    expect_identical(names(ans),
                     c("cohort", "sex", "time",
                       "stock",
                       "deaths", "immigration", "emigration", "internal_in", "internal_out",
                       "discrepancy"))
})