feat (WIP): Mean age of childbearing

NAMESPACE

@@ -17,6 +17,7 @@ export(gen_u5_ax)
 export(iterate_ax)
 export(leslie_matrix)
 export(lifetable)
+export(macb_from_nfx)
 export(mx_ax_to_qx)
 export(mx_qx_to_ax)
 export(mx_to_ax)

R/mcab.R

@@ -0,0 +1,64 @@
+#' @title Calculate Mean Age of Childbearing from Fertility Rate (MACB)
+#'
+#' @description
+#' The mean age at childbearing is the mean age of mothers at the birth of their
+#' children if women were subject throughout their lives to the age-specific
+#' fertility rates observed in a given year.
+#'
+#' See [UNPOP page][1] for more deatils.
+#'
+#' [1]: https://www.un.org/en/development/desa/population/publications/dataset/fertility/age-childbearing.asp
+#'
+#' @param dt \[`data.table()`\]\cr A data.table with columns 'age_start',
+#'   'age_end', and a column of fertility rates named after `nfx_col`.
+#' @param nfx_col \[`character(1)`\]\cr Name of fertility rate column in `dt`.
+#'   Defualts to "nfx".
+#' @inheritParams gen_lifetable_parameters
+#' @param value_col \[`character(1)`\]\cr Name of output 'MACB' column. Defaults
+#'   to "mcab"
+#'
+#' @return \[`data.table()`\] A data.table with calculated 'MACB' for each
+#'   unique grouping in `id_cols`, stored in `value_col`.
+#'
+#' @export
+#'
+#' @examples
+#' asfr_data <- data.table(
+#'   asfr = c(.051, .196, .208, .147, .075, .024, .004),
+#'   age_start = seq(15, 45, 5),
+#'   age_end = seq(20, 50, 5)
+#'  )
+#'
+#' id_cols <- c("age_start", "age_end")
+#' macb_dt <- macb_from_nfx(asfr_data, id_cols = id_cols, nfx_col = "asfr")
+#'
+#'
+macb_from_nfx <- function(dt, id_cols, nfx_col = "nfx", value_col = "macb") {
+
+
+  # Validate parameters -----------------------------------------------------
+
+  assertthat::assert_that(
+    assertthat::is.string(nfx_col),
+    assertthat::is.string(value_col)
+  )
+
+
+  # Prep id columns ---------------------------------------------------------
+
+  id_cols_no_age <- id_cols[!id_cols %in% c("age_start", "age_end")]
+
+
+  # Calculate MACB ----------------------------------------------------------
+
+  macb_dt <- dt[
+    ,
+    .(macb = weighted.mean((age_end + age_start) / 2, get(nfx_col))),
+    by = id_cols_no_age
+  ]
+
+  setnames(macb_dt, "macb", value_col)
+
+  return(macb_dt)
+
+}

tests/testthat/test-mcab.R

@@ -0,0 +1,23 @@
+test_that("MACB works", {
+
+  asfr_data <- data.table(
+    asfr = c(.051, .196, .208, .147, .075, .024, .004),
+    age_start = seq(15, 45, 5),
+    age_end = seq(20, 50, 5)
+  )
+
+  asfr_data2 <- data.table(
+    nfx = c(.2, .2),
+    age_start = c(20, 25),
+    age_end = c(25, 30)
+  )
+
+  id_cols <- c("age_start", "age_end")
+
+  macb_dt <- macb_from_nfx(asfr_data, id_cols = id_cols, nfx_col = "asfr")
+  macb_dt2 <- macb_from_nfx(asfr_data2, id_cols = id_cols)
+
+  testthat::expect_equal(macb_dt$macb, 28.11702, tolerance = 1e-5)
+  testthat::expect_equal(macb_dt2$macb, 25)
+
+})