tests/testthat/test-make_inputs.R

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

## 'make_births_of' -----------------------------------------------------------

test_that("'make_births_of' works without region", {
    classif_vars <- fake_classif_vars(n_age = 6L)
    data_births <- classif_vars[classif_vars$age == 3:4, ]
    data_births$count <- rpois(n = nrow(data_births), lambda = 3)
    data_births <- data_births[sample(nrow(data_births)), ]
    ans_obtained <- make_births_of(data_births = data_births,
                                   classif_vars = classif_vars)
    births_ag <- aggregate(data_births$count,
                           data_births[c("time", "sex")],
                           sum)
    names(births_ag)[1] <- "cohort"
    names(births_ag)[3] <- "counts_births_of"
    births_ag$counts_births_of <- as.list(births_ag$counts_births_of)
    ans_expected <- unique(classif_vars[c("cohort", "sex")])
    ans_expected$is_new_cohort <- FALSE
    ans_expected <- merge(ans_expected, births_ag,
                          by = c("cohort", "sex"),
                          all.x = TRUE,
                          sort = FALSE)
    ans_expected$is_new_cohort <- !sapply(ans_expected$counts_births_of, is.na)
    ans_expected <- sort_df(ans_expected, ignore = c("counts_births_of", "is_new_cohort"))
    expect_identical(ans_obtained, ans_expected)
    expect_identical(sum(data_births$count), sum(unlist(ans_obtained$counts_births_of), na.rm = TRUE))
})

test_that("'make_births_of' works with region", {
    set.seed(0)
    classif_vars <- fake_classif_vars(n_age = 3L, sex = FALSE, n_region = 3)
    data_births <- classif_vars[classif_vars$age == 2, ]
    data_births$count <- rpois(n = nrow(data_births), lambda = 3)
    data_births <- data_births[sample(nrow(data_births)), ]
    ans_obtained <- make_births_of(data_births = data_births,
                                   classif_vars = classif_vars)
    births_ag <- aggregate(data_births$count,
                           data_births[c("time", "gender", "region")],
                           sum)
    names(births_ag)[1] <- "cohort"
    names(births_ag)[4] <- "counts_births_of"
    births_ag <- to_list_col(df = births_ag,
                             nm_f = c("cohort", "gender"),
                             nm_x = "counts_births_of")
    ans_expected <- unique(classif_vars[c("cohort", "gender")])
    ans_expected$is_new_cohort <- FALSE
    ans_expected <- merge(ans_expected, births_ag,
                          by = c("cohort", "gender"),
                          all.x = TRUE,
                          sort = FALSE)
    ans_expected$is_new_cohort <- sapply(ans_expected$counts_births_of, function(x) !identical(x, NA))
    ans_expected <- sort_df(ans_expected, ignore = c("counts_births_of", "is_new_cohort"))
    expect_identical(ans_obtained, ans_expected)                                   
    expect_identical(sum(data_births$count), sum(unlist(ans_obtained$counts_births_of), na.rm = TRUE))
    sum_region_obtained <- colSums(do.call(rbind, ans_obtained$counts_births_of[ans_obtained$is_new_cohort]))
    sum_region_expected <- as.numeric(tapply(data_births$count, data_births$region, sum))
    expect_identical(sum_region_obtained, sum_region_expected)
})


## 'make_births_to' -----------------------------------------------------------

test_that("'make_births_to' works without region", {
    classif_vars <- fake_classif_vars(n_age = 6L)
    data_births <- classif_vars[classif_vars$age == 3:4, ]
    data_births$count <- rpois(n = nrow(data_births), lambda = 3)
    data_births <- data_births[sample(nrow(data_births)), ]
    ans_obtained <- make_births_to(data_births = data_births,
                                   classif_vars = classif_vars,
                                   dominant = "Female")
    births_ag <- aggregate(data_births["count"],
                           data_births[c("cohort", "time", "age")],
                           sum)
    births_ag$sex <- "Female"
    births_ag <- sort_df(births_ag, ignore = "count")
    births_ag <- to_list_col(births_ag,
                             nm_f = c("cohort", "sex"),
                             nm_x = "count")
    names(births_ag)[match("count", names(births_ag))] <- "counts_births_to"
    ans_expected <- unique(classif_vars[c("cohort", "sex")])
    ans_expected <- merge(ans_expected, births_ag,
                          by = c("cohort", "sex"),
                          all.x = TRUE,
                          sort = FALSE)
    ans_expected$has_births_to <- sapply(ans_expected$counts_births_to, function(x) !identical(x, NA))
    ans_expected <- sort_df(ans_expected, ignore = c("has_births_to", "counts_births_to"))
    ncol <- ncol(ans_expected)
    ans_expected <- ans_expected[c(1:(ncol-2), ncol, ncol-1)]
    expect_identical(ans_obtained, ans_expected)
    expect_identical(sum(data_births$count),
                     sum(unlist(ans_obtained$counts_births_to), na.rm = TRUE))
})

test_that("'make_births_to' works with region", {
    set.seed(0)
    classif_vars <- fake_classif_vars(n_age = 3L, sex = FALSE, n_region = 3)
    data_births <- classif_vars
    data_births$count <- rpois(n = nrow(data_births), lambda = 3)
    data_births <- data_births[sample(nrow(data_births)), ]
    ans_obtained <- make_births_to(data_births = data_births,
                                   classif_vars = classif_vars,
                                   dominant = "Diverse")
    births_ag <- aggregate(data_births["count"],
                           data_births[c("cohort", "time", "age", "region")],
                           sum)
    births_ag$gender <- "Diverse"
    births_ag <- sort_df(births_ag, ignore = "count")
    births_ag <- to_list_col(df = births_ag,
                             nm_f = c("cohort", "gender"),
                             nm_x = "count")
    names(births_ag)[match("count", names(births_ag))] <- "counts_births_to"
    births_ag$counts_births_to <- lapply(births_ag$counts_births_to, matrix, nrow = 3)
    ans_expected <- unique(classif_vars[c("cohort", "gender")])
    ans_expected <- merge(ans_expected, births_ag,
                          by = c("cohort", "gender"),
                          all.x = TRUE,
                          sort = FALSE)
    ans_expected$has_births_to <- sapply(ans_expected$counts_births_to, function(x) !identical(x, NA))
    ans_expected <- sort_df(ans_expected, ignore = c("has_births_to", "counts_births_to"))
    ncol <- ncol(ans_expected)
    ans_expected <- ans_expected[c(1:(ncol-2), ncol, ncol-1)]
    expect_identical(ans_obtained, ans_expected)                                   
    expect_identical(sum(data_births$count),
                     sum(unlist(ans_obtained$counts_births_to), na.rm = TRUE))
    births_to <- ans_obtained$counts_births_to
    births_to <- births_to[sapply(births_to, function(x) !identical(x, NA))]
    births_to <- sapply(births_to, rowSums)
    sum_region_obtained <- rowSums(births_to)
    sum_region_expected <- as.numeric(tapply(data_births$count, data_births$region, sum))
    expect_identical(sum_region_obtained, sum_region_expected)
})


## 'make_classif_vars' --------------------------------------------------------

test_that("'make_classif_vars' works without region", {
    deaths <- expand.grid(list(time = 2001:2000,
                               sex = c("Female", "Male"),
                               age = 0:3),
                          stringsAsFactors = FALSE,
                          KEEP.OUT.ATTRS = FALSE)
    deaths$count <- 1:16
    rates <- list(deaths = deaths)
    ans_obtained <- make_classif_vars(rates)
    ans_expected <- fake_classif_vars(n_age = 4L,
                                      n_time = 2L)
    expect_identical(ans_obtained, ans_expected)
})

test_that("'make_classif_vars' works with region", {
    deaths <- expand.grid(list(region = 2:1,
                               sex = c("Female", "Male"),
                               time = 2001:2000,
                               age = 0:3),
                          stringsAsFactors = FALSE,
                          KEEP.OUT.ATTRS = FALSE)
    deaths$region <- factor(deaths$region, levels = 1:2)
    deaths$count <- 1:32
    rates <- list(deaths = deaths)
    ans_obtained <- make_classif_vars(rates)
    ans_expected <- fake_classif_vars(n_age = 4L,
                                      n_time = 2L,
                                      n_region = 2L)
    expect_identical(ans_obtained, ans_expected)
})


## 'make_deaths' --------------------------------------------------------------

test_that("'make_deaths' works without region", {
    classif_vars <- fake_classif_vars(n_age = 6L)
    data_deaths <- classif_vars
    data_deaths$count <- rpois(n = nrow(data_deaths), lambda = 3)
    data_deaths <- data_deaths[sample(nrow(data_deaths)), ]
    ans_obtained <- make_deaths(data_deaths = data_deaths,
                                classif_vars = classif_vars)
    data_deaths <- sort_df(data_deaths, ignore = "count")
    data_deaths <- to_list_col(data_deaths,
                               nm_f = c("cohort", "sex"),
                               nm_x = "count")
    names(data_deaths)[match("count", names(data_deaths))] <- "counts_deaths"
    ans_expected <- unique(classif_vars[c("cohort", "sex")])
    ans_expected <- merge(ans_expected, data_deaths,
                          by = c("cohort", "sex"),
                          all.x = TRUE,
                          sort = FALSE)
    ans_expected <- sort_df(ans_expected, ignore = "counts_deaths")
    expect_identical(ans_obtained, ans_expected)
    expect_identical(sum(unlist(data_deaths$counts_deaths)),
                     sum(unlist(ans_obtained$counts_deaths), na.rm = TRUE))
})

test_that("'make_deaths' works with region", {
    set.seed(0)
    classif_vars <- fake_classif_vars(n_age = 3L, sex = FALSE, n_region = 3)
    data_deaths <- classif_vars
    data_deaths$count <- rpois(n = nrow(data_deaths), lambda = 3)
    sum_region_expected <- as.numeric(tapply(data_deaths$count, data_deaths$region, sum))
    data_deaths <- data_deaths[sample(nrow(data_deaths)), ]
    ans_obtained <- make_deaths(data_deaths = data_deaths,
                                classif_vars = classif_vars)
    data_deaths <- sort_df(data_deaths, ignore = "count")
    data_deaths <- to_list_col(df = data_deaths,
                               nm_f = c("cohort", "gender"),
                               nm_x = "count")
    names(data_deaths)[match("count", names(data_deaths))] <- "counts_deaths"
    data_deaths$counts_deaths <- lapply(data_deaths$counts_deaths, matrix, nrow = 3)
    ans_expected <- unique(classif_vars[c("cohort", "gender")])
    ans_expected <- merge(ans_expected, data_deaths,
                          by = c("cohort", "gender"),
                          all.x = TRUE,
                          sort = FALSE)
    ans_expected <- sort_df(ans_expected, ignore = "counts_deaths")
    expect_identical(ans_obtained, ans_expected)                                   
    expect_identical(sum(unlist(data_deaths$counts_deaths)),
                     sum(unlist(ans_obtained$counts_deaths), na.rm = TRUE))
    deaths <- ans_obtained$counts_deaths
    deaths <- deaths[sapply(deaths, function(x) !identical(x, NA))]
    deaths <- sapply(deaths, rowSums)
    sum_region_obtained <- rowSums(deaths)
    expect_identical(sum_region_obtained, sum_region_expected)
})


## 'make_df_birthdeath' -------------------------------------------------------

test_that("'make_df_birthdeath' works", {
    classif_vars <- fake_classif_vars(n_age = 6L)
    data_births <- classif_vars[classif_vars$age %in% 3:4, ]
    data_births$count <- as.numeric(rpois(n = nrow(data_births), lambda = 5))
    data_deaths <- classif_vars
    data_deaths$count <- as.numeric(rpois(n = nrow(data_deaths), lambda = 5))
    mod_births <- dm_exact(data = data_births,
                           nm_series = "births",
                           nm_data = "reg_births")
    mod_deaths <- dm_exact(data = data_deaths,
                           nm_series = "deaths",
                           nm_data = "reg_deaths")
    ans_obtained <- make_df_birthdeath(data_models = list(mod_births, mod_deaths),
                                       classif_vars = classif_vars,
                                       dominant = "Female")
    ans_expected <- make_births_of(data_births = data_births,
                                   classif_vars = classif_vars)
    births_to <- make_births_to(data_births = data_births,
                                classif_vars = classif_vars,
                                dominant = "Female")
    ans_expected$has_births_to <- births_to$has_births_to
    ans_expected$counts_births_to <- births_to$counts_births_to
    ans_expected$counts_deaths <- make_deaths(data_deaths = data_deaths,
                                              classif_vars = classif_vars)$counts_deaths
    expect_identical(ans_obtained, ans_expected)
})


## 'make_df_cdms' -----------------------------------------------------------

test_that("'make_df_cdms' works", {
    classif_vars_popn <- fake_classif_vars_popn(n_age = 6L)
    data_popn1 <- classif_vars_popn
    data_popn1$count <- rpois(n = nrow(data_popn1), lambda = 10)
    data_popn2 <- classif_vars_popn
    data_popn2$count <- rpois(n = nrow(data_popn2), lambda = 10)
    classif_vars <- fake_classif_vars(n_age = 6L)
    data_immigration1 <- classif_vars
    data_immigration1$count <- rpois(n = nrow(data_immigration1), lambda = 5)
    data_emigration1 <- classif_vars
    data_emigration1$count <- rpois(n = nrow(data_emigration1), lambda = 5)
    mod_popn1 <- dm_poibin(data = data_popn1,
                           prob = 0.95,
                           nm_series = "population",
                           nm_data = "reg_popn1")
    mod_popn2 <- dm_poibin(data = data_popn2,
                           prob = 0.95,
                           nm_series = "population",
                           nm_data = "reg_popn2")
    mod_immigration1 <- dm_poibin(data = data_immigration1,
                                  prob = 0.95,
                                  nm_series = "immigration1",
                                  nm_data = "reg_immigration1")
    mod_emigration1 <- dm_poibin(data = data_emigration1,
                                 prob = 0.96,
                                 nm_series = "emigration1",
                                 nm_data = "reg_emigration1")
    data_models <- list(mod_popn1, mod_popn2, mod_immigration1, mod_emigration1)
    ans <- make_df_cdms(data_models = data_models,
                        classif_vars = classif_vars)
    expect_identical(ans[1:2], unique(classif_vars[c("cohort", "sex")]))
    expect_true(all(sapply(ans$cdms_emigration2, is, "Rcpp_CdmsNoreg")))
    expect_true(all(sapply(ans$cdms_stock, is, "Rcpp_CdmsNoreg")))
    expect_true(all(sapply(ans$cdms_immigration1, is, "Rcpp_CdmsNoreg")))
    expect_true(all(sapply(ans$cdms_emigration1, is, "Rcpp_CdmsNoreg")))
    expect_identical(names(ans),
                     c("cohort", "sex",
                       "cdms_stock",
                       "cdms_immigration1", "cdms_emigration1",
                       "cdms_immigration2", "cdms_emigration2"))
})


## 'make_df_estimate' -----------------------------------------------------------

## THIS NEEDS MORE WORK
test_that("'make_df_estimate' works", {
    set.seed(0)
    classif_vars <- fake_classif_vars(n_age = 3L)
    ## rates
    classif_vars_rates <- unique(classif_vars[-match("cohort", names(classif_vars))])
    rates_births <- unique(classif_vars_rates[-match("sex", names(classif_vars_rates))])
    rates_births <- rates_births[rates_births$age == 1, , drop = FALSE]
    rates_births$rate <- runif(n = nrow(rates_births))
    rates_deaths <- classif_vars_rates
    rates_deaths$rate <- runif(n = nrow(rates_deaths))
    rates_immigration <- classif_vars_rates
    rates_immigration$rate <- runif(n = nrow(rates_immigration))
    rates_emigration <- classif_vars_rates
    rates_emigration$rate <- runif(n = nrow(rates_emigration))
    rates <- list(births = rates_births,
                  deaths = rates_deaths,
                  immigration = rates_immigration,
                  emigration = rates_emigration)
    ## data models
    data_population <- fake_classif_vars_popn(n_age = 3L)
    data_population$count <- rpois(n = nrow(data_population), lambda = 20)
    data_births <- classif_vars[classif_vars$age == 1, , drop = FALSE]
    data_births$count <- rpois(n = nrow(data_births), lambda = 5)
    data_deaths <- classif_vars
    data_deaths$count <- rpois(n = nrow(data_deaths), lambda = 5)
    data_immigration <- classif_vars
    data_immigration$count <- rpois(n = nrow(data_immigration), lambda = 5)
    data_emigration <- classif_vars
    data_emigration$count <- rpois(n = nrow(data_emigration), lambda = 5)
    mod_population <- dm_poibin(data = data_population,
                                prob = 0.95,
                                nm_series = "population",
                                nm_data = "reg_population")
    mod_births <- dm_exact(data = data_births,
                           nm_series = "births",
                           nm_data = "reg_births")
    mod_deaths <- dm_exact(data = data_deaths,
                           nm_series = "deaths",
                           nm_data = "reg_deaths")
    mod_immigration <- dm_poibin(data = data_immigration,
                                 prob = 0.95,
                                 nm_series = "immigration",
                                 nm_data = "reg_immigration")
    mod_emigration <- dm_poibin(data = data_emigration,
                                prob = 0.96,
                                nm_series = "emigration",
                                nm_data = "reg_emigration")
    data_models <- list(mod_population,
                        mod_births,
                        mod_deaths,
                        mod_immigration,
                        mod_emigration)
    ## df
    ans_obtained <- make_df_estimate(rates = rates,
                                     data_models = data_models,
                                     dominant = "Female")
    expect_true(is.data.frame(ans_obtained))
})
    
test_that("'make_df_meta' works - no regions", {
    set.seed(0)
    classif_vars <- fake_classif_vars()
    ans <- make_df_meta(classif_vars)
    expect_identical(ans[ans$cohort == 1998 & ans$sex == "Female", "meta"][[1L]],
                     data.frame(time = c(2000L, 2000L, 2001L),
                                age = c(1L, 2L, 2L)))
    expect_identical(ans[ans$cohort == 2002 & ans$sex == "Male", "meta"][[1L]],
                     data.frame(time = 2002L, age = 0L))
})

test_that("'make_df_meta' works - with regions", {
    set.seed(0)
    classif_vars <- fake_classif_vars(n_region = 2L)
    ans <- make_df_meta(classif_vars)
    expect_identical(ans[ans$cohort == 1998 & ans$sex == "Female", "meta"][[1L]],
                     data.frame(time = rep(c(2000L, 2000L, 2001L), each = 2),
                                age = rep(c(1L, 2L, 2L), each = 2),
                                region = factor(rep(1:2, times = 3))))
    expect_identical(ans[ans$cohort == 2002 & ans$sex == "Male", "meta"][[1L]],
                     data.frame(time = c(2002L, 2002L),
                                age = c(0L, 0L),
                                region = factor(1:2)))
})



## 'make_df_rates' ------------------------------------------------------------

test_that("'make_df_rates' works - no regions, one type of immigration/emigration", {
    set.seed(0)
    classif_vars <- fake_classif_vars(n_age = 6L,
                                      sex = FALSE)
    classif_vars_rate <- unique(classif_vars[-match("cohort", names(classif_vars))])
    births <- unique(classif_vars_rate[-match("gender", names(classif_vars_rate))])
    births <- births[births$age %in% 3:4, ]
    births$rate <- runif(n = nrow(births))
    deaths <- classif_vars_rate
    deaths$rate <- runif(n = nrow(deaths))
    immigration <- classif_vars_rate
    immigration$rate <- runif(n = nrow(immigration))
    emigration <- classif_vars_rate
    emigration$rate <- runif(n = nrow(emigration))
    ans_obtained <- make_df_rates(rates = list(births = births,
                                               deaths = deaths,
                                               immigration = immigration,
                                               emigration = emigration),
                                  classif_vars = classif_vars,
                                  dominant = "Diverse")
    births$gender <- "Diverse"
    names(births)[match("rate", names(births))] <- "rates_births"
    names(deaths)[match("rate", names(deaths))] <- "rates_deaths"
    names(immigration)[match("rate", names(immigration))] <- "rates_immigration"
    names(emigration)[match("rate", names(emigration))] <- "rates_emigration"
    ans_expected <- merge(classif_vars, births, by = c("gender", "time", "age"), all.x = TRUE, sort = FALSE)
    ans_expected <- merge(ans_expected, deaths, by = c("gender", "time", "age"), all.x = TRUE, sort = FALSE)
    ans_expected <- merge(ans_expected, immigration, by = c("gender", "time", "age"), all.x = TRUE, sort = FALSE)
    ans_expected <- merge(ans_expected, emigration, by = c("gender", "time", "age"), all.x = TRUE, sort = FALSE)
    names(ans_expected)[match(c("rates_immigration", "rates_emigration"),
                              names(ans_expected))] <- c("rates_immigration1", "rates_emigration1")
    ans_expected$rates_immigration2 <- 0
    ans_expected$rates_emigration2 <- 0
    ans_expected$rates_births[is.na(ans_expected$rates_births)] <- 0
    ans_expected <- ans_expected[order(ans_expected$cohort,
                                       ans_expected$gender,
                                       ans_expected$time,
                                       ans_expected$age), ]
    ans_expected <- to_list_col(ans_expected,
                                nm_f <- c("cohort", "gender"),
                                nm_x <- c("rates_births", "rates_deaths",
                                          "rates_immigration1", "rates_emigration1",
                                          "rates_immigration2", "rates_emigration2"))
    rownames(ans_expected) <- NULL
    expect_identical(ans_obtained, ans_expected)
})

test_that("'make_df_rates' works - no regions, two types of immigration/emigration", {
    set.seed(0)
    classif_vars <- fake_classif_vars(n_age = 6L,
                                      sex = FALSE)
    classif_vars_rate <- unique(classif_vars[-match("cohort", names(classif_vars))])
    births <- unique(classif_vars_rate[-match("gender", names(classif_vars_rate))])
    births <- births[births$age %in% 3:4, ]
    births$rate <- runif(n = nrow(births))
    deaths <- classif_vars_rate
    deaths$rate <- runif(n = nrow(deaths))
    immigration1 <- classif_vars_rate
    immigration1$rate <- runif(n = nrow(immigration1))
    emigration1 <- classif_vars_rate
    emigration1$rate <- runif(n = nrow(emigration1))
    immigration2 <- classif_vars_rate
    immigration2$rate <- runif(n = nrow(immigration2))
    emigration2 <- classif_vars_rate
    emigration2$rate <- runif(n = nrow(emigration2))
    ans_obtained <- make_df_rates(rates = list(births = births,
                                               deaths = deaths,
                                               immigration1 = immigration1,
                                               emigration1 = emigration1,
                                               immigration2 = immigration2,
                                               emigration2 = emigration2),
                                  classif_vars = classif_vars,
                                  dominant = "Diverse")
    births$gender <- "Diverse"
    names(births)[match("rate", names(births))] <- "rates_births"
    names(deaths)[match("rate", names(deaths))] <- "rates_deaths"
    names(immigration1)[match("rate", names(immigration1))] <- "rates_immigration1"
    names(emigration1)[match("rate", names(emigration1))] <- "rates_emigration1"
    names(immigration2)[match("rate", names(immigration2))] <- "rates_immigration2"
    names(emigration2)[match("rate", names(emigration2))] <- "rates_emigration2"
    ans_expected <- merge(classif_vars, births, by = c("gender", "time", "age"), all.x = TRUE, sort = FALSE)
    ans_expected <- merge(ans_expected, deaths, by = c("gender", "time", "age"), all.x = TRUE, sort = FALSE)
    ans_expected <- merge(ans_expected, immigration1, by = c("gender", "time", "age"), all.x = TRUE, sort = FALSE)
    ans_expected <- merge(ans_expected, emigration1, by = c("gender", "time", "age"), all.x = TRUE, sort = FALSE)
    ans_expected <- merge(ans_expected, immigration2, by = c("gender", "time", "age"), all.x = TRUE, sort = FALSE)
    ans_expected <- merge(ans_expected, emigration2, by = c("gender", "time", "age"), all.x = TRUE, sort = FALSE)
    ans_expected$rates_births[is.na(ans_expected$rates_births)] <- 0
    ans_expected <- ans_expected[order(ans_expected$cohort,
                                       ans_expected$gender,
                                       ans_expected$time,
                                       ans_expected$age), ]
    ans_expected <- to_list_col(ans_expected,
                                nm_f <- c("cohort", "gender"),
                                nm_x <- c("rates_births", "rates_deaths",
                                          "rates_immigration1", "rates_emigration1",
                                          "rates_immigration2", "rates_emigration2"))
    rownames(ans_expected) <- NULL
    expect_identical(ans_obtained, ans_expected)
})

test_that("'make_df_rates' works - with regions, two types of immigration/emigration", {
    set.seed(0)
    classif_vars <- fake_classif_vars(n_age = 6L,
                                      n_region = 3L)
    classif_vars_rate <- unique(classif_vars[-match("cohort", names(classif_vars))])
    births <- unique(classif_vars_rate[-match("sex", names(classif_vars_rate))])
    births <- births[births$age %in% 3:4, ]
    births$rate <- runif(n = nrow(births))
    deaths <- classif_vars_rate
    deaths$rate <- runif(n = nrow(deaths))
    immigration1 <- classif_vars_rate
    immigration1$rate <- runif(n = nrow(immigration1))
    emigration1 <- classif_vars_rate
    emigration1$rate <- runif(n = nrow(emigration1))
    immigration2 <- classif_vars_rate
    immigration2$rate <- runif(n = nrow(immigration2))
    emigration2 <- classif_vars_rate
    emigration2$rate <- runif(n = nrow(emigration2))
    internal_in <- classif_vars_rate
    internal_in$rate <- runif(n = nrow(internal_in))
    internal_out <- classif_vars_rate
    internal_out$rate <- runif(n = nrow(internal_out))
    ans_obtained <- make_df_rates(rates = list(births = births,
                                               deaths = deaths,
                                               immigration1 = immigration1,
                                               emigration1 = emigration1,
                                               immigration2 = immigration2,
                                               emigration2 = emigration2,
                                               internal_in = internal_in,
                                               internal_out = internal_out),
                                  classif_vars = classif_vars,
                                  dominant = "Female")
    births$sex <- "Female"
    names(births)[match("rate", names(births))] <- "rates_births"
    names(deaths)[match("rate", names(deaths))] <- "rates_deaths"
    names(immigration1)[match("rate", names(immigration1))] <- "rates_immigration1"
    names(emigration1)[match("rate", names(emigration1))] <- "rates_emigration1"
    names(immigration2)[match("rate", names(immigration2))] <- "rates_immigration2"
    names(emigration2)[match("rate", names(emigration2))] <- "rates_emigration2"
    names(internal_in)[match("rate", names(internal_in))] <- "rates_internal_in"
    names(internal_out)[match("rate", names(internal_out))] <- "rates_internal_out"
    by <- c("sex", "time", "age", "region")
    ans_expected <- merge(classif_vars, births, by = by, all.x = TRUE, sort = FALSE)
    ans_expected <- merge(ans_expected, deaths, by = by, all.x = TRUE, sort = FALSE)
    ans_expected <- merge(ans_expected, immigration1, by = by, all.x = TRUE, sort = FALSE)
    ans_expected <- merge(ans_expected, emigration1, by = by, all.x = TRUE, sort = FALSE)
    ans_expected <- merge(ans_expected, immigration2, by = by, all.x = TRUE, sort = FALSE)
    ans_expected <- merge(ans_expected, emigration2, by = by, all.x = TRUE, sort = FALSE)
    ans_expected <- merge(ans_expected, internal_in, by = by, all.x = TRUE, sort = FALSE)
    ans_expected <- merge(ans_expected, internal_out, by = by, all.x = TRUE, sort = FALSE)
    ans_expected$rates_births[is.na(ans_expected$rates_births)] <- 0
    ans_expected <- ans_expected[order(ans_expected$cohort,
                                       ans_expected$sex,
                                       ans_expected$time,
                                       ans_expected$age,
                                       ans_expected$region), ]
    ans_expected <- to_list_col(ans_expected,
                                nm_f <- c("cohort", "sex"),
                                nm_x <- c("rates_births", "rates_deaths",
                                          "rates_immigration1", "rates_emigration1",
                                          "rates_immigration2", "rates_emigration2",
                                          "rates_internal_in", "rates_internal_out"))
    for (i in 3:10)
        ans_expected[[i]] <- lapply(ans_expected[[i]], function(x) matrix(x, nrow = 3))
    rownames(ans_expected) <- NULL
    expect_identical(ans_obtained, ans_expected)
})


## 'tidy_data_dm' ------------------------------------------------------------

test_that("'tidy_data_dm' returns expected answer", {
    data <- fake_classif_vars(n_region = 2)
    data$count <- seq_len(nrow(data))
    expect_true(check_data_dm(data, is_popn = FALSE))
    ans_obtained <- tidy_data_dm(data)
    ans_expected <- data
    ans_expected$age <- as.integer(data$age)
    ans_expected$cohort <- as.integer(data$cohort)
    ans_expected$time <- as.integer(data$time)
    ans_expected$count <- as.numeric(data$count)
    expect_identical(ans_obtained, ans_expected)
})