グラフまとめ

世界人口統計

wpp2015 , plotrix , pyramid パッケージ

平均寿命

日本人の平均寿命及び予想平均寿命
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
library(wpp2015)
library(plotrix)
#平均寿命のデータ
#e0M:男性,e0F:女性,
data(e0M);data(e0F) 
#png("wpp2015_1.png",width=1000,height=800)
par(mfrow=c(1,2))
plot(t(subset(e0F,country=="Japan")[,3:15]),type="o",pch=15,col="red",ylim=c(60,97),xaxt="n",las=1,xlab="",ylab="")
lines(t(subset(e0M,country=="Japan")[,3:15]),type="o",pch=16,col ="black")
axis(1, labels=FALSE, at=1:13)
staxlab(1,1:13,colnames(e0M[3:15]),srt=45)
legend("topleft", legend = c("Male","Female"), col =c("black","red"), pch =c(16,15), lty =1)
title("日本人の平均寿命")
#2015年以降の予想平均寿命:e0Mproj ;e0Fproj
data(e0Mproj);data(e0Fproj)
#日本のデータ
subset(e0Mproj, e0Mproj[, 1] == "Japan")
subset(e0Fproj, e0Mproj[, 1] == "Japan")
plot(t(subset(e0Fproj,country=="Japan")[,3:19]),type="o",pch=15,col="red",ylim=c(60,97),xaxt="n",las=1,xlab="",ylab="",lty=3)
lines(t(subset(e0Mproj,country=="Japan")[,3:19]),type="o",pch=16,col ="black",lty=3)
axis(1, labels=FALSE, at=1:17)
staxlab(1,1:17,colnames(e0Mproj[3:19]),srt=45)
legend("topleft", legend = c("Male","Female"), col =c("black","red"), pch =c(16,15), lty =3)
title("日本人の予想平均寿命")
par(mfrow=c(1,1))
#dev.off()

１つのグラフにする
1
2
3
4
5
6
7
8
9
10
11
12
13
Female<-rbind(t(subset(e0F,country=="Japan")[,3:15]),t(subset(e0Fproj,country=="Japan")[,3:19]))
Male<-rbind(t(subset(e0M,country=="Japan")[,3:15]),t(subset(e0Mproj,country=="Japan")[,3:19]))
#png("wpp2015_2.png",width=1000,height=800)
plot(Female,type="n",pch=15,col="red",ylim=c(60,97),xaxt="n",las=1,xlab="",ylab="")
lines(Female[1:13],type="o",pch=15,col ="red",lwd=2)
lines(c(rep(NA,12),Female[13:30]),type="o",pch=15,col ="red",lty=3)
lines(Male[1:13],type="o",pch=16,col ="black",lwd=2)
lines(c(rep(NA,12),Male[13:30]),type="o",pch=16,col ="black",lty=3)
axis(1, labels=FALSE, at=1:30)
staxlab(1,1:30,rownames(Male),srt=45)
legend("topleft", legend = c("Male","Female"), col =c("black","red"), pch =c(16,15), lty =1)
title("日本人の平均寿命及び予想平均寿命")
#dev.off()

合計特殊出生率(total fertility rate)

日本
1
2
3
4
5
6
7
8
9
10
11
12
#library(wpp2015)
#合計特殊出生率(total fertility rate)
data(tfr) 
#head(tfr)
#ja<- subset(tfr,country=="Japan")
ja<- subset(tfr,country_code==392)
#tfr[order(tfr[,15],decreasing=TRUE),]
#png("wpp2015_3.png",width=1000,height=800)
plot(t(ja[,3:15]),type="o",pch=19,lty=1,lwd=2,las=1,xaxt="n",xlab="",ylab="")
axis(1,1:13,colnames(tfr[,3:15]),cex.axis=0.8)
title("合計特殊出生率(日本)")
#dev.off()

東アジアの国と地域

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
x<-c(410,158,156,408,392,344,446,496)
data<-subset(tfr,country_code==x[1])
for (i in 2:length(x)){
d<-subset(tfr,country_code==x[i])
data<-rbind(data,d)
}
#2010-2015のデータの降順に並べ替え
data<-data[order(data[,15],decreasing=TRUE),]
#png("wpp2015_4.png",width=1000,height=800)
par(mfrow=c(1,2))
matplot(t(data[,3:15]),type="o",pch=19,lty=1,lwd=2,col=1:length(x),las=1,xaxt="n",xlab="",ylab="")
axis(1,1:13,colnames(tfr[,3:15]),cex.axis=0.8)
legend("topright",legend=data$country,pch=19,lty=1,lwd=2,col=1:length(x))
title("合計特殊出生率(東アジアの国と地域)")
#合計特殊出生率 1990 ～ (東アジアの国と地域)
matplot(t(data[,11:15]),type="o",pch=19,lty=1,lwd=2,col=1:length(x),las=1,xaxt="n",xlab="",ylab="")
axis(1,1:5,colnames(tfr[,11:15]),cex.axis=0.8)
legend("topright",legend=data$country,pch=19,lty=1,lwd=2,col=1:length(x),ncol=2)
title("合計特殊出生率 1990 ～ (東アジアの国と地域)")
par(mfrow=c(1,1))
#dev.off()

人口のデータ

男女別人口の推移(日本)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
#data(pop)
data(popM)
data(popF)
jaM<- subset(popM,country=="Japan")
jaF<- subset(popF,country=="Japan")
#apply(jaM[,4:17],2,sum)
#apply(jaF[,4:17],2,sum)
#png("wpp2015_5.png",width=1000,height=800)
plot(apply(jaF[,4:17],2,sum),type="o",pch=19,lty=1,lwd=2,col="red",las=1,xaxt="n",xlab="",ylab="",ylim=c(35000,66000))
lines(apply(jaM[,4:17],2,sum),type="o",pch=19,lty=1,lwd=2,col="black")
axis(1:length(apply(jaF[,4:17]),2,sum),colnames(jaM[4:17]),cex.axis=0.8)
legend("topleft",legend=c("男性","女性"),pch=19,lty=1,lwd=2,col=c("black","red"))
title("男女別人口の推移 (日本 単位：千人)")
#dev.off()

人口ピラミッド

pyramid パッケージ

1
2
3
4
5
6
7
8
9
10
11
12
13
14
#2015
#人口ピラミッドを作成するデータを抽出
jaM[3];jaM[17];jaF[17]
#データフレーム化
popJ<-data.frame(jaM[3],jaM[17],jaF[17])
names(popJ)<-c("age","male","femal")
#年齢は５才刻み
age<-seq(0,100,5)
library(pyramid)
#png("wpp2015_6.png",width=1000,height=800)
pyramids(Left=popJ[,2], Right=popJ[,3], Center=age, Laxis=seq(0,6000,1000),
Clab="Age", Llab="Male", Rlab="Female", Cstep=1,
main="Population Pyramid of Japan 2015(unit:10^3)")
#dev.off()

plotrix パッケージ pyramid.plot関数

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
library(plotrix)
#1950年
#人口ピラミッドを作成するデータを抽出
jaM[3];jaM[4];jaF[4]
#データフレーム化
popJ<-data.frame(jaM[3],jaM[4],jaF[4])
names(popJ)<-c("age","male","femal")
 #mcol<-color.gradient(c(0,0,0.5,1),c(0,0,0.5,1),c(1,1,0.5,1),21)
 #fcol<-color.gradient(c(1,1,0.5,1),c(0.5,0.5,0.5,1),c(0.5,0.5,0.5,1),21)
mcol<-"lightblue"
fcol<-"pink"
#png("wpp2015_7.png",width=1000,height=800)
 par(mar=pyramid.plot(popJ[,2],popJ[,3],labels=popJ[,1],top.labels=colnames(popJ[c(2,1,3)]),
  main="Japanese population pyramid 1950",lxcol=mcol,rxcol=fcol,unit="千人",laxlab=seq(0,6000,500),
  raxlab=seq(0,6000,500),gap=500,show.values=T)) #,do.first="plot_bg(\"#eedd55\")"
#dev.off()