# 図6.5 コール=マクニールの初婚モデルの当てはめ if (!require(fmsb)) { install.packages("fmsb"); library(fmsb) } plot(MR ~ YEAR, data=Jvital, type="l", ylab="Crude Marriage Rate") # Coale and McNeil (1972)のコーディング(fmsbで定義) CM # Coale and McNeil (1972)を初婚スケジュールに当てはめる(fmsbで定義) fitCM # E-statから2015年国勢調査の既婚女性割合を読み,CMを当てはめてパラメータ推定 URL <- "https://www.e-stat.go.jp/stat-search/file-download?statInfId=000031473217&fileKind=1" x <- read.csv(URL, skip=16, header=FALSE, as.is=TRUE) # 2015年国勢調査人口 Ages <- 15:54 EverMarriedF <- as.numeric(x[1:40, 30])/as.numeric(x[1:40, 28]) # 15歳から54歳女性の既婚割合 res <- fitCM(initialpar=c(0.8, 18, 2), data=EverMarriedF, ages=Ages, mode=2) while(res[5]>0) { res <- fitCM(initialpar=c(0.8, 18, 2), data=EverMarriedF, ages=Ages, mode=2) } print(res) fitted <- CM(res[1], res[2], res[3]) # CMの返り値は10歳から60歳まで plot(Ages, EverMarriedF, xlab="年齢", ylab="既婚女性割合", main="2015年国勢調査における15歳から54歳の既婚女性割合") lines(Ages, fitted$G[6:45], col="red") NFORM <- "C=%3.1f, a0=%3.1f, k=%3.1f\n mu=%3.1f, sd=%3.1f" text(40, 0.2, sprintf(NFORM, res[1], res[2], res[3], fitted$mu, fitted$sigma)) print(sum(Ages*fitted$g[Ages-9]/sum(fitted$g[Ages-9]))) # 推定された平均初婚年齢