R/datamodel-methods.R

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

## Create a list of 'cdm_dataset' objects from a data model ---------------

## Turn an object of class "data model" into a list
## of objects of class "cdm"
## 'data_model' - an object of class "data model"
## 'classif_vars' - a data frame
## return value - a list of objects of class "cdm"

## HAS_TESTS
#' @export
make_list_cdm.dm_poibin <- function(data_model, classif_vars) {
    data <- data_model$data
    prob <- data_model$prob
    nm_series <- data_model$nm_series
    is_popn <- nm_series == "population"
    has_region <- "region" %in% names(classif_vars)
    list_data <- make_list_dm_df(df = data,
                                 classif_vars = classif_vars,
                                 is_popn = is_popn)
    if (has_region)
        constructor <- new_CdmWithregPoibin
    else
        constructor <- new_CdmNoregPoibin
    ans <- lapply(list_data,
                  constructor,
                  prob = prob)
    ans
}

## NO_TESTS
#' @export
make_list_cdm.dm_nbinom <- function(data_model, classif_vars) {
    data <- data_model$data
    ratio <- data_model$ratio
    disp <- data_model$disp
    nm_series <- data$nm_series
    is_popn <- nm_series == "population"
    has_region <- "region" %in% names(classif_vars)
    list_data <- make_list_dm_df(df = data,
                                 classif_vars = classif_vars,
                                 is_popn = is_popn)
    list_ratio <- make_list_dm_df(df = ratio,
                                  classif_vars = classif_vars,
                                  is_popn = is_popn)
    list_disp <- make_list_dm_df(df = disp,
                                 classif_vars = classif_vars,
                                 is_popn = is_popn)
    if (has_region)
        constructor <- new_CdmWithregNbinom
    else
        constructor <- new_CdmNoregNbinom
    ans <- mapply(constructor,
                  counts_data = list_data,
                  ratio = list_ratio,
                  disp = list_disp)
    ans
}


## Printing -------------------------------------------------------------------

## HAS_TESTS
#' @export
print.dm_poibin <- function(x, ...) {
    cat("Poisson-binomial mixture (poibin) data model\n\n")
    cat("dataset:", x$nm_data, "\n")
    cat("series:", x$nm_series, "\n")
    cat("prob:", x$prob, "\n\n")
    cat("data:\n")
    print(summary(x$data))
    invisible(x)
}

## HAS_TESTS
#' @export
print.dm_exact <- function(x, ...) {
    cat("Exact data model\n\n")
    cat("dataset:", x$nm_data, "\n")
    cat("series:", x$nm_series, "\n\n")
    cat("data:\n")
    print(summary(x$data))
    invisible(x)
}