tests/testthat/test-reaggregate_rates.R

In ageutils: Collection of Functions for Working with Age Intervals

test_that("reaggregate_rates without weights works", {
    bounds <- c(0,  10,  50, 100, 200)
    rates <- as.double(seq_along(bounds))
    out <- reaggregate_rates(bounds = bounds, rates = rates, new_bounds = bounds)
    expected <- tibble::tibble(lower = bounds, upper = c(bounds[-1], Inf), rate = rates)
    expect_identical(out[-1L], expected)

    bounds2 <- c(0, 5, 10, 25, 50, 75, 100, 150, 200)
    out <- reaggregate_rates(bounds = bounds, rates = rates, new_bounds = bounds2)
    expected <- tibble::tibble(
        lower = bounds2,
        upper = c(bounds2[-1], Inf),
        rate = head(rep(rates, each = 2), -1)
    )
    expect_identical(out[-1L], expected)

    out <- reaggregate_rates(bounds = bounds, rates = rates, new_bounds = 200)
    expected <- tibble::tibble(lower = c(0,200), upper = c(200, Inf), rate = c(3.2, 5))
    expect_identical(out[-1L], expected)

    bounds <- c(0, 1, 5)
    rates <- c(0.15, 0.30, 0.80)
    dat <- reaggregate_rates(bounds, rates, new_bounds = c(0, 5))
    expect_equal(
        dat$rate[1],
        ((bounds[3] - bounds[2]) * rates[2] + (bounds[2] - bounds[1]) * rates[1]) / (bounds[3] - bounds[1])
    )
})

test_that("reaggregate_rates with weights works - example 1", {

    skip_if_not_installed("dplyr")

    bounds <- c(0, 10, 50, 100, 180)
    rates <- c(0.1, 0.3, 0.2, 0.1, 0.5)
    new_bounds <- c(0, 60, 150, 180)
    population_bounds <- c(0, 80, 150, 180)
    population_weights <- c(10, 20, 30, 40)

    current <- reaggregate_rates(
        bounds = bounds,
        rates  = rates,
        new_bounds = new_bounds,
        population_bounds = population_bounds,
        population_weights = population_weights
    )

    target <- reaggregate_rates_edwin_weighted(
        bounds = bounds,
        rates  = rates,
        new_bounds = new_bounds,
        population_bounds = population_bounds,
        population_weights = population_weights
    )

    current <- current[-c(1,3)]
    expect_equal(
        current,
        setNames(target, names(current))
    )

})

test_that("reaggregate_rates with weights works - example 2", {

    skip_if_not_installed("dplyr")

    bounds <- c(0, 10, 50, 100, 160)
    rates <- c(0.1, 0.3, 0.2, 0.1, 0.5)
    new_bounds <- c(0, 60, 80, 150, 170, 180)
    population_bounds <- c(0, 80, 150, 180)
    population_weights <- c(10, 20, 30, 40)

    current <- reaggregate_rates(
        bounds = bounds,
        rates  = rates,
        new_bounds = new_bounds,
        population_bounds = population_bounds,
        population_weights = population_weights
    )

    target <- reaggregate_rates_edwin_weighted(
        bounds = bounds,
        rates  = rates,
        new_bounds = new_bounds,
        population_bounds = population_bounds,
        population_weights = population_weights
    )

    current <- current[-c(1,3)]
    expect_equal(
        current,
        setNames(target, names(current))
    )

})