# Table 6.1 ASFRs <- c(0.2004, 0.3373, 0.3109, 0.2615, 0.1970, 0.0954, 0.0135) names(ASFRs) <- c("15-19", "20-24", "25-29", "30-34", "35-39", "40-44", "45-49") STPOP <- c(1,1,1,1,1,1,1) sum(ASFRs*5*STPOP) # TFR is not mean level, but total. So it is not divided by sum(STPOP) # Table 6.2 Px <- c(340483, 326154, 312699, 323441, 338904, 362161, 379642, 34439, 31009, 142691) Dx <- c(6234, 368, 269, 237, 175, 179, 171, 3753, 3669, 22483) names(Px) <- c("0-1", "1-2", "2-3", "3-4", "4-5", "5-6", "6-7", "83-4", "84-5", "85+") Mx <- Dx/Px print(Mx) ax <- c(0.09, 0.43, 0.45, 0.47, 0.49, 0.50, 0.50, 0.50, 0.50, NA) qx <- ifelse(is.na(ax), 1, Mx/(1+(1-ax)*Mx)) print(qx) # Table 6.3 n <- c(1, 4, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, NA) nqx <- c(0.008252, 0.001630, 0.000905, 0.000935, 0.001409, 0.001534, 0.001818, 0.002826, 0.004410, 0.007199, 0.012348, 0.020831, 0.035455, 0.058507, 0.087310, 0.139189, 0.220993, 0.352367, 1) npx <- 1-nqx nLx <- ndx <- lx <- rep(0, length(npx)) lx[1] <- 100000 for (i in 2:length(lx)) { lx[i] <- lx[i-1]*npx[i-1] ndx[i-1] <- lx[i-1]-lx[i] } ndx[length(lx)] <- lx[length(lx)] nLx[1] <- n[1]*(lx[2] + 0.1*ndx[1]) nLx[2] <- n[2]*(lx[3] + 0.4*ndx[2]) for (i in 3:(length(lx)-1)) { nLx[i] <- n[i]*(lx[i+1] + 0.5*ndx[i]) # same as n[i]*(lx[i]+lx[i+1])/2 } nLx[length(lx)] <- lx[length(lx)]/0.177987 # See, text pp.76-77 Tx <- rev(cumsum(rev(nLx))) ex <- Tx/lx (T6.3 <- data.frame(n, nqx, npx, lx=as.integer(lx), ndx=as.integer(ndx), nLx=as.integer(nLx), Tx=as.integer(Tx), ex=sprintf("%6.3f",ex))) # Slight differences from Table 6.3 may be rounding errors. # # Using fmsb package (>=0.4.5), lifetable2() function easily gives the result. library(fmsb) mx <- c(0.008314, 0.000408, 0.000181, 0.000187, 0.000282, 0.000307, 0.000364, 0.000566, 0.000884, 0.001445, 0.002485, 0.004210, 0.007219, 0.012054, 0.018259, 0.029920, 0.049689, 0.085545, 0.177987) (T6.3x <- lifetable2(mx, ax=c(0.1, 0.4, rep(0.5, 16), NA), n=c(1, 4, rep(5, 16), NA)))