R/brass_pf.R

In josehcms/fertestr: Package for Fertility and Parity Estimation

#' Brass PF Fertility Estimation
#'
#' @param ages A vector of starting ages of five-year age groups ranging from 15 to 45 (default = c(15,20,25,30,35,40,45))
#' @param P A vector of mean parities by five-year age group - same groups as 'ages'
#' @param asfr A vector of age-specific fertility rates by five-year age group - same groups as 'ages'
#' @param adjust_group A vector of age-groups from 'ages' to be used for selection of PF ratios to adjust asfr data
#' (default set to 20 (20-24 five-year age group))
#'
#' @return A list with 3 elements:
#' pf_data data frame with columns ages, P for mean parities, asfr, Fi for cumulate fertility estimated from Brass coefficients,PF for ratios P/F and adj_asfr for adjusted asfr;
#' tfr_unadj for unadjusted total fertility rate estimate;
#' and tfr_adj for adjusted total fertility rate estimate by applying the selected age-group PF ratio
#' @export
#' @source
#' Brass W, AJ. 1968. Coale Methods  of  analysis  and  estimation.  In:  BRASS,  W.  et  al.  (Ed.).  The demography of tropical Africa. 1. ed. New Jersey: Princeton University Press, p. 88-139.
#' Brass W. 1975. Methods for Estimating Fertility and Mortality from Limited and Defected Data. North Carolina: Carolina Population Center.
#' @examples
#' ## Malawi 2008 Census data:
#' ages_ma = c(15, 20, 25, 30, 35, 40, 45)
#' asfr_ma = c(0.111, 0.245, 0.230, 0.195, 0.147, 0.072, 0.032)
#' P_ma    = c(0.283, 1.532, 2.849, 4.185, 5.214, 6.034, 6.453)
#' fertBrassPF(P = P_ma, asfr = asfr_ma)
#'
#'

fertBrassPF <-
  function( ages = seq(15,45,5),
            P,
            asfr,
           adjust_group = c(20)){

    mult.pf_brass <- DemoToolsData::mult.pf_brass

  # INPUTS:
  ## ages : 5 year age group from 15 to 49 as a vector c(15,20,25,30,35,40,45) by default
  ## P    : mean number of children ever born to women from age group x
  ## asfr : age specific fertility rates of age group x

  # 1. Check if inputs have the correct dimensions
    stopifnot( all.equal( length(ages), length(P), length(asfr)) )

  # 2. Create a matrix with three input vectors
  pf_data <-
    data.frame( ages , P , asfr)

  # 3. Compute mean age at respective age group
  ages_mean <-
    pf_data$ages + 2.5

  # 4. Compute mean age at motherhood
  mean_age_moth <-
    sum(ages_mean*pf_data$asfr)/sum(pf_data$asfr)

  # 5. Compute ratio P(1)/P(2)
  p_ratio <-
    pf_data$P[1] / pf_data$P[2]

  # # 6. Entry of multipliers matrix
  # mult_data <-
  #   data.frame(
  #     ages = c( "15-19" , "20-24" , "25-29" , "30-34" , "35-39" , "40-44" , "45-49" , "P1/P2" , "f1/f2" , "m"),
  #     Int1 = c( 1.120 , 2.555 , 2.925 , 3.055 , 3.165 , 3.325 , 3.640 , 0.014 , 0.036 , 31.7),
  #     Int2 = c( 1.310 , 2.690 , 2.960 , 3.075 , 3.190 , 3.375 , 3.895 , 0.045 , 0.113 , 30.7),
  #     Int3 = c( 1.615 , 2.780 , 2.985 , 3.095 , 3.215 , 3.435 , 4.150 , 0.090 , 0.213 , 29.7),
  #     Int4 = c( 1.950 , 2.840 , 3.010 , 3.120 , 3.245 , 3.510 , 4.395 , 0.143 , 0.330 , 28.7),
  #     Int5 = c( 2.305 , 2.890 , 3.035 , 3.140 , 3.285 , 3.610 , 4.630 , 0.205 , 0.460 , 27.7),
  #     Int6 = c( 2.640 , 2.925 , 3.055 , 3.165 , 3.325 , 3.740 , 4.840 , 0.268 , 0.605 , 26.7),
  #     Int7 = c( 2.925 , 2.960 , 3.075 , 3.190 , 3.375 , 3.915 , 4.985 , 0.330 , 0.764 , 25.7),
  #     Int8 = c( 3.170 , 2.985 , 3.095 , 3.215 , 3.435 , 4.150 , 5.000 , 0.387 , 0.939 , 24.7)
  #     )

  # 7. Find the interval in which the p_ratio lies in
  int.p <-
    findInterval(
      p_ratio,
      mult.pf_brass[ 8 , 2:9 ]
    )

  # 8. Find alpha.1 by interpolation of p_ratio
  alpha.1 <-
    ( p_ratio - mult.pf_brass[ 8 , ( int.p + 1 ) ] ) / ( mult.pf_brass[ 8 , ( int.p + 2 ) ] - mult.pf_brass[ 8 , ( int.p + 1 ) ] )

  # 9. Three first age groups coefficients are generated by interpolation with alpha.1
  group.1 <-
    mult.pf_brass[ 1:3 , ( int.p + 1 ) : ( int.p + 2 ) ]

  group.1$ks <-
    alpha.1 * ( group.1[ , 2 ] - group.1[ , 1 ] ) + group.1[ , 1 ]

  # 10. Find the interval in which the mean age at motherhood lies in
  int.m <-
    8 -
    findInterval(
      mean_age_moth,
      sort(mult.pf_brass[10,2:9])
    )

  # 11. If mean age at motherhood is higher than upper bound, add it into the last interval 30.7-31.7
  if ( int.m == 8 ){
    warning('Mean age of motherhood is greater than 31.7')
    int.m <- 7
  }

  # 12. Compute alpha.2 by interpolation of mean age at motherhood with found age interval
  alpha.2 <-
    ( mean_age_moth - mult.pf_brass[ 10 , ( int.m + 1 ) ] ) /
    ( mult.pf_brass[ 10 , ( int.m + 2 ) ] - mult.pf_brass[ 10 , ( int.m + 1 ) ] )

  # 13. Four age groups coefficients are generated by interpolation with alpha.2
  group.2 <-
    mult.pf_brass[ 4:7 , ( int.m + 1 ) : ( int.m + 2 ) ]

  group.2$ks <-
    alpha.2 * ( group.2[ , 2 ] - group.2[ , 1 ] ) + group.2[ , 1 ]

  # 14. Create coefficients vector and add to data
  pf_data$ki <-
    c( group.1$ks , group.2$ks )

  # 15. Cumulate asfr for Fi estimation
  pf_data$delta <- 0

  for ( i in 1:6 ) {
    pf_data[ i+1 , 'delta'] <-
      ( pf_data[ i , 'asfr' ] ) * 5 + ( pf_data[ i , 'delta' ] )
  }

  # 16. Multiply coefficients ki by asfr and add to delta to estimate Fi
  pf_data$Fi <-
    round( pf_data$delta + pf_data$ki * pf_data$asfr, 3 )

  # 17. Compute PF ratios
  pf_data$PF <-
    round( pf_data$P / pf_data$Fi, 3)

  # 18. Adjust asfr by selected age groups PF ratio mean (default = 20-24)
  pf_data$adj_asfr <-
    round( mean( pf_data$PF[ ages %in% adjust_group ] ) * pf_data$asfr, 3 )

  # 19. set returning list of results
  pf_output <-
    list(
      pf_data   = pf_data[,c('ages', 'P', 'asfr', 'Fi', 'PF', 'adj_asfr')],
      tfr_unadj = round( sum( pf_data$asfr*5 ), 3),
      tfr_adj   = round( sum( pf_data$adj_asfr * 5 ), 3)
    )

  return(pf_output)
}


#' Brass PF Fertility Estimation using Coale-Trussel coefficients
#'
#' @param ages A vector of starting ages of five-year age groups ranging from 15 to 45 (default = c(15,20,25,30,35,40,45))
#' @param P A vector of mean parities by five-year age group - same groups as 'ages'
#' @param asfr A vector of age-specific fertility rates by five-year age group - same groups as 'ages'
#' @param adjust_group A vector of age-groups from 'ages' to be used for selection of PF ratios to adjust asfr data
#' (default set to 20 (20-24 five-year age group))
#' @param age_shift TRUE (default) if fertility rates are calculated from births in a 12-month period
#' by age of mothed at the end of period and FALSE if fertility rates are calculated from births by
#' age of mother at the end of the period
#'
#' @return A list with 3 elements:
#' pf_data data frame with columns ages, P for mean parities, asfr, Fi for cumulate fertility estimated from Brass coefficients,PF for ratios P/F and adj_asfr for adjusted asfr;
#' tfr_unadj for unadjusted total fertility rate estimate;
#' and tfr_adj for adjusted total fertility rate estimate by applying the selected age-group PF ratio
#' @export
#' @source
#' United Nations. 1983. Manual X: Indirect techniques for demographic estimation
#' (United Nations publication, Sales No. E.83.XIII.2).
#' @examples
#' ## Bangladesh 1974 survey data:
#' ages_bd = c(15, 20, 25, 30, 35, 40, 45)
#' asfr_bd = c(0.1063, 0.2296, 0.2154, 0.1825, 0.1339, 0.0644, 0.0336)
#' P_bd    = c(0.385, 1.847, 3.485, 4.917, 5.861, 6.194, 6.084)
#' fertBrassPF.cltrss(P = P_bd, asfr = asfr_bd, adjust_group = c(20,25,30))
#'
#'

fertBrassPF.cltrss <-
  function( ages = seq(15,45,5),
            P,
            asfr,
            adjust_group = c(20),
           age_shift = TRUE){

    mult.age_shift <- DemoToolsData::mult.age_shift
    mult.cltrs_noshift <- DemoToolsData::mult.cltrs_noshift
    mult.cltrs_shift <- DemoToolsData::mult.cltrs_shift

    # 1. Check if inputs have the correct dimensions
    stopifnot( all.equal( length(ages), length(P), length(asfr)) )

    # 2. Create a matrix with three input vectors
    pf_data <-
      data.frame( ages , P , asfr)

    # 3. Cumulate asfr for Fi estimation
    pf_data$phi <-
      pf_data$asfr * 5

    for ( i in 2:7 ) {
      pf_data[ i , 'phi'] <-
        ( pf_data[ i , 'asfr' ] ) * 5 + ( pf_data[ i - 1 , 'phi' ] )
    }

    # 4. Select which multipliers to use
    if (age_shift == TRUE){
      mult.cltrs <-
        mult.cltrs_shift
    } else{
      mult.cltrs <-
        mult.cltrs_noshift
    }

    # 5. Compute Fi from phi values and Coale-Trussel multipliers
    pf_data$Fi <- NA

    pf_data$Fi[1] <-
      0 +
      mult.cltrs$ai[1] * pf_data$asfr[1] +
      mult.cltrs$bi[1] * pf_data$asfr[2] +
      mult.cltrs$ci[1] * pf_data$phi[7]

    for ( i in 2:6 ) {
      pf_data$Fi[i] <-
        pf_data$phi[ i - 1 ] +
        mult.cltrs$ai[ i ] * pf_data$asfr[ i ] +
        mult.cltrs$bi[ i ] * pf_data$asfr[ i + 1] +
        mult.cltrs$ci[ i ] * pf_data$phi[7]
    }

    pf_data$Fi[7] <-
      pf_data$phi[6] +
      mult.cltrs$ai[7] * pf_data$asfr[7] +
      mult.cltrs$bi[7] * pf_data$asfr[6] +
      mult.cltrs$ci[7] * pf_data$phi[7]

    # 6. Calculation of fertility schedule for conventional 5-year age group if age_shift == TRUE
    if (age_shift == TRUE){
      pf_data$wi <-
        NA

      for (i in 1:6){
        pf_data$wi[i] <-
          mult.age_shift$xi[i] +
          mult.age_shift$yi[i] * pf_data$asfr[i] / pf_data$phi[7] +
          mult.age_shift$zi[i] * pf_data$asfr[i + 1] / pf_data$phi[7]
      }

      pf_data$asfr_shift <-
        NA

      pf_data$asfr_shift[1] <-
        pf_data$asfr[1] * ( 1 ) + pf_data$wi[1] * pf_data$asfr[2]

      pf_data$asfr_shift[7] <-
        pf_data$asfr[7] * ( 1 - pf_data$wi[6] )

      for (i in 2:6){
        pf_data$asfr_shift[i] <-
          pf_data$asfr[i] * ( 1 - pf_data$wi[i-1] ) +
          pf_data$wi[i] * pf_data$asfr[i+1]
      }
    }

    # 7. Compute PF ratios
    pf_data$PF <-
      round( pf_data$P / pf_data$Fi, 3)

    # 8. Adjust asfr by selected age groups PF ratio mean (default = 20-24)
    if (age_shift == TRUE){
      pf_data$adj_asfr <-
        round( mean( pf_data$PF[ pf_data$ages %in% adjust_group ] ) * pf_data$asfr_shift, 3 )
    } else{
      pf_data$adj_asfr <-
        round( mean( pf_data$PF[ pf_data$ages %in% adjust_group ] ) * pf_data$asfr, 3 )
    }

    # 9. Set returning list of results
    pf_output <-
      list(
        pf_data   = pf_data[,c('ages', 'P', 'asfr', 'Fi', 'PF', 'adj_asfr')],
        tfr_unadj = round( sum( pf_data$asfr*5 ), 3),
        tfr_adj   = round( sum( pf_data$adj_asfr * 5 ), 3)
      )

    return(pf_output)
  }