# population projection with menu # 3rd January 2012 # coded by Minato Nakazawa library(fmsb) library(pyramid) DUR <- 201 wx <- length(Jpopl[, "Age"]) mqxn <- "qx2005M"; mmx <- qxtomx(Jlife[, mqxn]) mcx <- length(mmx[!is.na(mmx)]) if (mcx < wx-1) { mmx <- c(mmx[!is.na(mmx)], rep(0, wx-mcx-1)) } else { mmx <- mmx[1:(wx-1)] } fqxn <- "qx2005F"; fmx <- qxtomx(Jlife[, fqxn]) fcx <- length(fmx[!is.na(fmx)]) if (fcx < wx-1) { fmx <- c(fmx[!is.na(fmx)], rep(0, wx-fcx-1)) } else { fmx <- fmx[1:(wx-1)] } FERTN <- "ASFR2005"; asfr <- c(rep(0, 15), Jfert[, FERTN], rep(0, wx-55)) windows(); par(cex=0.8, las=1) mp <- fp <- matrix(rep(0, wx*DUR), wx, DUR) mp[, 1] <- Jpopl[, "M2010"] # set 2010 males as initial males' population fp[, 1] <- Jpopl[, "F2010"] # set 2010 females as initial females' population pmp <- mp[, 1]/sum(mp[, 1]); pfp <- fp[, 1]/sum(fp[, 1]) DAT <- data.frame(M=pmp, F=pfp, A=Jpopl[, 1]) pyramid(DAT, Laxis=0:3/100, Cstep=10, main="Start from 2010 structure") # Population projection for coming "DUR" years # Ignoring migration for (j in 2:DUR) { baby <- sum(fp[, j-1]*asfr) babym <- as.integer(baby*1.06/2.06+0.5) babyf <- as.integer(baby*1/2.06+0.5) mp[1, j] <- babym fp[1, j] <- babyf mp[2:wx, j] <- as.integer(mp[1:(wx-1), j-1]*(1-mmx)) fp[2:wx, j] <- as.integer(fp[1:(wx-1), j-1]*(1-fmx)) } windows(); par(cex=0.8, las=1) for (i in 2:DUR) { pyramid(data.frame(M=mp[, i]/sum(mp[, i]), F=fp[, i]/sum(fp[, i]), A=Jpopl[, 1]), Laxis=0:3/100, Cstep=10, main=sprintf("%d years later: projected with\n %s, %s and %s", i-1, mqxn, fqxn, FERTN)) Sys.sleep(1) } mp <- fp <- matrix(rep(0, wx*DUR), wx, DUR) mp1 <- Jpopl[, "M1888"]; mp1[is.na(mp1)] <- 0; mp[, 1] <- mp1 # 1888年男性を初期男性人口に。欠損を0に fp1 <- Jpopl[, "F1888"]; fp1[is.na(fp1)] <- 0; fp[, 1] <- fp1 # 1888年女性を初期女性人口に。欠損を0に windows(); par(cex=0.8, las=1) pmp <- mp[, 1]/sum(mp[, 1]); pfp <- fp[, 1]/sum(fp[, 1]) DAT <- data.frame(M=pmp, F=pfp, A=Jpopl[, 1]) pyramid(DAT, Laxis=0:3/100, Cstep=10, main="Start from 1888 structure") # Population projection for coming "DUR" years # Ignoring migration for (j in 2:DUR) { baby <- sum(fp[, j-1]*asfr) babym <- as.integer(baby*1.06/2.06+0.5) babyf <- as.integer(baby*1/2.06+0.5) mp[1, j] <- babym fp[1, j] <- babyf mp[2:wx, j] <- as.integer(mp[1:(wx-1), j-1]*(1-mmx)) fp[2:wx, j] <- as.integer(fp[1:(wx-1), j-1]*(1-fmx)) } windows(); par(cex=0.8, las=1) for (i in 2:DUR) { pyramid(data.frame(M=mp[, i]/sum(mp[, i]), F=fp[, i]/sum(fp[, i]), A=Jpopl[, 1]), Laxis=0:3/100, Cstep=10, main=sprintf("%d years later: projected with\n %s, %s and %s", i-1, mqxn, fqxn, FERTN)) Sys.sleep(1) }