# R code for chapter 5.
# Cohort Fertility by directly entering figures
(15+103+136+84+46+13+1)/1000*5
# Cohort Fertility by file
T5.1 <- read.delim("http://minato.sip21c.org/demography-special/EnglandWales1940.txt")
# Calculate CFR for 1920-4 birth cohort
sum(diag(as.matrix(T5.1[,2:8])))*5/1000
# Calculate CFR for 1925-9 birth cohort
sum(diag(as.matrix(T5.1[,3:9])))*5/1000
# Calculate CFR for 1930-4 birth cohort
sum(diag(as.matrix(T5.1[,4:10])))*5/1000
# Calculate CFR for 1935-9 birth cohort
sum(diag(as.matrix(T5.1[,5:11])))*5/1000
# Calculate CFR for 1940-4 birth cohort (Note: 45-49 is censored)
sum(diag(as.matrix(T5.1[,6:11])))*5/1000
# For Japanese data, since ASFRs are given for each age, it must be summed up for 5 year age-groups
library(fmsb)
x <- function(i) { tapply(Jfert[, i], ((Jfert$Age-10) %/% 5), sum) }
y <- Vectorize(x)
z <- y(2:15)
sum(diag(z[, 1:8])) # CFR for 1935-1939 birth cohort of Japanese females (Note: *5/1000 is not necessary)
sum(diag(z[, 2:9])) # CFR for 1940-1944 birth cohort of Japanese females
sum(diag(z[, 3:10])) # CFR for 1945-1949 birth cohort of Japanese females
sum(diag(z[, 4:11])) # CFR for 1950-1954 birth cohort of Japanese females
sum(diag(z[, 5:12])) # CFR for 1955-1959 birth cohort of Japanese females
sum(diag(z[, 6:13])) # CFR for 1960-1964 birth cohort of Japanese females
sum(diag(z[, 7:14])) # CFR for 1965-1969 birth cohort of Japanese females
T5.2 <- read.delim("http://minato.sip21c.org/demography-special/EnglandWales192044CFR.txt")
T5.3 <- read.delim("http://minato.sip21c.org/demography-special/EnglandWales192069ASFR.txt")
T5.4 <- read.delim("http://minato.sip21c.org/demography-special/EnglandWales192069CFC.txt")
# T5.4 is cumulative sums of T5.3 for row direction times 5 / 1000.
t(apply(T5.3[,2:8], 1, cumsum))*5/1000 # generates essentially same result with T5.4
T5.5 <- read.delim("http://minato.sip21c.org/demography-special/Australia1911-65-CFMC.txt")
T5.6 <- read.delim("http://minato.sip21c.org/demography-special/table5-6.txt")
# The calculation of T5.6 by R can alternatively be done as below.
CEB <- 0:10 # Number of Children Ever Born
W45.49 <- c(14352, 26548, 29268, 33271, 39448,
44928, 48252, 49401, 46789, 41112, 80995) # Women aged 45-49
WCEB <- rev(cumsum(rev(W45.49))) # Women aged 45-49 with children at least CEB
PPR <- c(WCEB[-1],0)/WCEB # Parity Progression Ratios
# Estimating cohort fertility (1)
products <- PPR
for (i in 2:11) {products[i] <- products[i-1]*PPR[i]}
print(cbind(CEB, W45.49, WCEB, PPR, products))
sum(products)
# Estimating cohort fertility (2)
sum(CEB*W45.49)/sum(W45.49)