library(fmsb) # 2015年人口 M2015 <- Jpop$M2015 F2015 <- Jpop$F2015 i1 <- length(M2015)-1 i2 <- length(M2015)-2 # 2015年母の年齢別出生率 ASFR <- c(rep(0, 15), Jfert$ASFR2015, rep(0, 31)) # 2015年出産数 B2015 <- as.integer(sum(F2015*ASFR)) # 2015年年齢別生残率から2016年人口 M2016 <- as.integer(c(B2015*(1.06/2.06), M2015[1:i2]*(1-qxtomx(Jlife$qx2015M))[1:i2], M2015[i1]*(1-qxtomx(Jlife$qx2015M))[i1]+ M2015[i2]*(1-qxtomx(Jlife$qx2015M))[i2])) F2016 <- as.integer(c(B2015*(1/2.06), F2015[1:i2]*(1-qxtomx(Jlife$qx2015F))[1:i2], F2015[i1]*(1-qxtomx(Jlife$qx2015F))[i1]+ F2015[i2]*(1-qxtomx(Jlife$qx2015F))[i2])) print(B2015) # 2016年出産数 B2016 <- as.integer(sum(F2016*ASFR*1.44/1.45)) # 2016年年齢別生残率から2017年人口 M2017 <- as.integer(c(B2016*(1.06/2.06), M2016[1:i2]*(1-qxtomx(Jlife$qx2015M))[1:i2], M2016[i1]*(1-qxtomx(Jlife$qx2015M))[i1]+ M2016[i2]*(1-qxtomx(Jlife$qx2015M))[i2])) F2017 <- as.integer(c(B2016*(1/2.06), F2016[1:i2]*(1-qxtomx(Jlife$qx2015F))[1:i2], F2016[i1]*(1-qxtomx(Jlife$qx2015F))[i1]+ F2016[i2]*(1-qxtomx(Jlife$qx2015F))[i2])) print(B2016) # 2017年出産数 B2017 <- as.integer(sum(F2017*ASFR*1.43/1.45)) # 2017年年齢別生残率から2018年人口 M2018 <- as.integer(c(B2017*(1.06/2.06), M2017[1:i2]*(1-qxtomx(Jlife$qx2015M))[1:i2], M2017[i1]*(1-qxtomx(Jlife$qx2015M))[i1]+ M2017[i2]*(1-qxtomx(Jlife$qx2015M))[i2])) F2018 <- as.integer(c(B2017*(1/2.06), F2017[1:i2]*(1-qxtomx(Jlife$qx2015F))[1:i2], F2017[i1]*(1-qxtomx(Jlife$qx2015F))[i1]+ F2017[i2]*(1-qxtomx(Jlife$qx2015F))[i2])) print(B2017) # 2018年出産数 B2018 <- as.integer(sum(F2018*ASFR*1.42/1.45)) # 2018年年齢別生残率から2019年人口 M2019 <- as.integer(c(B2018*(1.06/2.06), M2018[1:i2]*(1-qxtomx(Jlife$qx2015M))[1:i2], M2018[i1]*(1-qxtomx(Jlife$qx2015M))[i1]+ M2018[i2]*(1-qxtomx(Jlife$qx2015M))[i2])) F2019 <- as.integer(c(B2018*(1/2.06), F2018[1:i2]*(1-qxtomx(Jlife$qx2015F))[1:i2], F2018[i1]*(1-qxtomx(Jlife$qx2015F))[i1]+ F2018[i2]*(1-qxtomx(Jlife$qx2015F))[i2])) print(B2018) # 2019年出産数 B2019 <- as.integer(sum(F2019*ASFR*1.37/1.45)) # 2019年年齢別生残率から2020年人口 M2020 <- as.integer(c(B2019*(1.06/2.06), M2019[1:i2]*(1-qxtomx(Jlife$qx2015M))[1:i2], M2019[i1]*(1-qxtomx(Jlife$qx2015M))[i1]+ M2019[i2]*(1-qxtomx(Jlife$qx2015M))[i2])) F2020 <- as.integer(c(B2019*(1/2.06), F2019[1:i2]*(1-qxtomx(Jlife$qx2015F))[1:i2], F2019[i1]*(1-qxtomx(Jlife$qx2015F))[i1]+ F2019[i2]*(1-qxtomx(Jlife$qx2015F))[i2])) print(B2019) # 2016年出産数c B2016c <- as.integer(sum(F2016*ASFR)) # 2016年年齢別生残率から2017年人口 M2017c <- as.integer(c(B2016c*(1.06/2.06), M2016[1:i2]*(1-qxtomx(Jlife$qx2015M))[1:i2], M2016[i1]*(1-qxtomx(Jlife$qx2015M))[i1]+ M2016[i2]*(1-qxtomx(Jlife$qx2015M))[i2])) F2017c <- as.integer(c(B2016c*(1/2.06), F2016[1:i2]*(1-qxtomx(Jlife$qx2015F))[1:i2], F2016[i1]*(1-qxtomx(Jlife$qx2015F))[i1]+ F2016[i2]*(1-qxtomx(Jlife$qx2015F))[i2])) print(B2016c) # 2017年出産数 B2017c <- as.integer(sum(F2017c*ASFR)) # 2017年年齢別生残率から2018年人口 M2018c <- as.integer(c(B2017c*(1.06/2.06), M2017c[1:i2]*(1-qxtomx(Jlife$qx2015M))[1:i2], M2017c[i1]*(1-qxtomx(Jlife$qx2015M))[i1]+ M2017c[i2]*(1-qxtomx(Jlife$qx2015M))[i2])) F2018c <- as.integer(c(B2017c*(1/2.06), F2017c[1:i2]*(1-qxtomx(Jlife$qx2015F))[1:i2], F2017c[i1]*(1-qxtomx(Jlife$qx2015F))[i1]+ F2017c[i2]*(1-qxtomx(Jlife$qx2015F))[i2])) print(B2017c) # 2018年出産数 B2018c <- as.integer(sum(F2018c*ASFR)) # 2018年年齢別生残率から2019年人口 M2019c <- as.integer(c(B2018c*(1.06/2.06), M2018c[1:i2]*(1-qxtomx(Jlife$qx2015M))[1:i2], M2018c[i1]*(1-qxtomx(Jlife$qx2015M))[i1]+ M2018c[i2]*(1-qxtomx(Jlife$qx2015M))[i2])) F2019c <- as.integer(c(B2018c*(1/2.06), F2018c[1:i2]*(1-qxtomx(Jlife$qx2015F))[1:i2], F2018c[i1]*(1-qxtomx(Jlife$qx2015F))[i1]+ F2018c[i2]*(1-qxtomx(Jlife$qx2015F))[i2])) print(B2018c) # 2019年出産数 B2019c <- as.integer(sum(F2019c*ASFR)) # 2019年年齢別生残率から2020年人口 M2020c <- as.integer(c(B2019c*(1.06/2.06), M2019c[1:i2]*(1-qxtomx(Jlife$qx2015M))[1:i2], M2019c[i1]*(1-qxtomx(Jlife$qx2015M))[i1]+ M2019c[i2]*(1-qxtomx(Jlife$qx2015M))[i2])) F2020c <- as.integer(c(B2019c*(1/2.06), F2019c[1:i2]*(1-qxtomx(Jlife$qx2015F))[1:i2], F2019c[i1]*(1-qxtomx(Jlife$qx2015F))[i1]+ F2019c[i2]*(1-qxtomx(Jlife$qx2015F))[i2])) print(B2019c) options(scipen=5) BN <- data.frame( year = 2015:2019, vital = c(1005721, 977242, 946146, 918400, 864000), est = c(B2015, B2016, B2017, B2018, B2019), estc = c(B2015, B2016c, B2017c, B2018c, B2019c)) matplot(BN$year, BN[,2:4], type="l", lty=1:3, col=1:3, xlab="年次", ylab="推定出生数", main="最近5年間の日本の出生数推移") legend("bottomleft", lty=1:3, col=1:3, legend=c("人口動態統計(2018年まで確定数,2019年は推計)", "コホート要因法での推計1(2015年国調人口と生命表+2015年年齢別出生率からTFRでスケーリング)", "コホート要因法での推計2(2015年国調人口と生命表+2015年年齢別出生率で固定)"), cex=0.6)