R/get-constants.R

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

## HAS_TESTS
## Get valid names for demographic series
## 'incl_popn' - whether to include "population"
## 'one_imem' - whether to use one or two immigration and emigration series;
##    if NULL, include entries for both
## 'incl_internal' - whether to include "internal_in" and "internal_out"
## return value - character vector
get_names_series <- function(incl_popn, incl_stock, one_imem, incl_internal) {
    names_population <- "population"
    names_stock <- "stock"
    names_birthdeath <- c("births",
                          "deaths")
    names_one_imem <- c("immigration",
                        "emigration")
    names_two_imem <- c("immigration1",
                        "emigration1",
                        "immigration2",
                        "emigration2")
    names_internal <- c("internal_in",
                        "internal_out")
    ans <- character()
    if (incl_popn)
        ans <- c(ans, names_population)
    if (incl_stock)
        ans <- c(ans, names_stock)
    ans <- c(ans, names_birthdeath)
    if (is.null(one_imem))
        ans <- c(ans, names_one_imem, names_two_imem)
    else if (one_imem)
        ans <- c(ans, names_one_imem)
    else
        ans <- c(ans, names_two_imem)
    if (incl_internal)
        ans <- c(ans, names_internal)
    ans
}


## HAS_TESTS
## Get sets of possible vaid names for demographic series
## 'incl_popn' - whether to include "population" in the sets
## 'incl_stock' - whether to include "stock" in the sets
## return value - a list of character vectors
get_sets_names_series <- function(incl_popn, incl_stock) {
    list(get_names_series(incl_popn = incl_popn,
                          incl_stock = incl_stock,
                          one_imem = FALSE,
                          incl_internal = FALSE),
         get_names_series(incl_popn = incl_popn,
                          incl_stock = incl_stock,
                          one_imem = TRUE,
                          incl_internal = FALSE),
         get_names_series(incl_popn = incl_popn,
                          incl_stock = incl_stock,
                          one_imem = FALSE,
                          incl_internal = TRUE),
         get_names_series(incl_popn = incl_popn,
                          incl_stock = incl_stock,
                          one_imem = TRUE,
                          incl_internal = TRUE))
}


## HAS_TESTS
## Get valid names for classification variables.
## 'incl_cohort' - whether the names should include "cohort"
## 'incl_sex' - whether the names should include "sex"
## 'incl_gender' - whether the names should include "gender"
## 'incl_region' - whether the names should include "region"
## return value - a character vector
get_names_classif_vars <- function(incl_cohort, incl_sex, incl_gender, incl_region) {
    ans <- c("age", "time")
    if (incl_cohort)
        ans <- c(ans, "cohort")
    if (incl_sex)
        ans <- c(ans, "sex")
    if (incl_gender)
        ans <- c(ans, "gender")
    if (incl_region)
        ans <- c(ans, "region")
    ans
}


## HAS_TESTS
## Check sets of possible names for classification variables.
## If an 'incl' argument is TRUE, then the sets always include
## the associated name. If an 'incl' argument is FALSE, then
## the sets never include the associated name. If an
## 'incl' argument is NULL, half the sets contain the
## associated name and half do not.
## If 'incl_sexgender' is TRUE, then half the sets
## contain the name "sex" and half contain the name "gender".
## 'incl_cohort' - whether the names should include "cohort"
## 'incl_sexgender' - whether the names should include "sex" or "gender"
## 'incl_region' - whether the names should include "region"
get_sets_names_classif_vars <- function(incl_cohort,
                                        incl_sexgender,
                                        incl_region) {
    if (is.null(incl_cohort))
        incl_cohort <- c(FALSE, TRUE)
    if (is.null(incl_region))
        incl_region <- c(FALSE, TRUE)
    incl_sex <- c(FALSE, TRUE)
    incl_gender <- c(FALSE, TRUE)
    args <- expand.grid(incl_cohort = incl_cohort,
                        incl_sex = incl_sex,
                        incl_gender = incl_gender,
                        incl_region = incl_region,
                        KEEP.OUT.ATTRS = FALSE)
    sex_plus_gender <- args$incl_sex + args$incl_gender
    if (is.null(incl_sexgender))
        keep <- sex_plus_gender < 2L
    else if (isTRUE(incl_sexgender))
        keep <- sex_plus_gender == 1L
    else
        keep <- sex_plus_gender == 0L
    args <- args[keep, , drop = FALSE]
    mapply(get_names_classif_vars,
           incl_cohort = args$incl_cohort,
           incl_sex = args$incl_sex,
           incl_gender = args$incl_gender,
           incl_region = args$incl_region,
           SIMPLIFY = FALSE)
}


## HAS_TESTS
get_nms_series_cdms <- function(nms_classif) {
    has_region <- "region" %in% nms_classif
    ans <- c("stock",
             "immigration1",
             "emigration1",
             "immigration2",
             "emigration2")
    if (has_region)
        ans <- c(ans,
                 "internal_in",
                 "internal_out")
    ans
}