【第１章イントロダクション】練習問題1.5.2「世界人口の動態を理解する」

うんぱか

１．データセットの入手

　・練習問題を解くにあたって使用するデータセットは以下のリンク先でダウンロードできる。

２.練習問題1.5.2「世界人口の動態を理解する」

（１）粗出生率（CBR）の計算
　　①ケニアのCBR
　　　1)1950-1955年は0.052程度、2005-2010年は0.038程度。
　　　2)50年間でCBRは、0.013ほど低下している。
　　②スウェーデンのCBR
　　　1)1950-1955年は0.015程度、2005-2010年は0.012程度。
　　　2)50年間でCBRは、0.003ほど低下している。
　　③世界のCBR
　　　1)1950-1955年は0.037程度、2005-2010年は0.020程度。
　　　2)50年間でCBRは、0.017ほど低下している。
　　④まとめ
　　　・CBRは1950-1955年の方が高く、時間と共に低下している。
　　　・但し、低下の幅は先進国と発展途上国で異なる。

> kenya <- read.csv("Kenya.csv")
> kenya$py.person <- kenya$py.women + kenya$py.men

> sweden <- read.csv("Sweden.csv")
> sweden$py.person <- sweden$py.women + sweden$py.men

> world <- read.csv("World.csv")
> world$py.person <- world$py.women + world$py.men

> kenya.CBR <- (tapply(kenya$births,kenya$period,sum,na.rm = TRUE)/tapply(kenya$py.person,kenya$period,sum,na.rm=TRUE))
> kenya.CBR
 1950-1955  2005-2010 
0.05209490 0.03851507 

> kenya.CBR[1] - kenya.CBR[2]
 1950-1955 
0.01357983 

> sweden.CBR <- (tapply(sweden$births,sweden$period,sum,na.rm = TRUE)/tapply(sweden$py.person,sweden$period,sum,na.rm = TRUE))
> sweden.CBR
 1950-1955  2005-2010 
0.01539614 0.01192554 

> sweden.CBR[1] - sweden.CBR[2]
  1950-1955 
0.003470599 

> world.CBR <- (tapply(world$births,world$period,sum,na.rm = TRUE)/tapply(world$py.person,world$period,sum,na.rm = TRUE))
> world.CBR
 1950-1955  2005-2010 
0.03732863 0.02021593 

> world.CBR[1] - world.CBR[2]
1950-1955 
0.0171127

（２）年齢別出生率出生率（ASFR）の計算
　＜計算の考え方＞
　　①各地域のデータセットから年層（age）が15-49歳の行のみを抽出。
　　②期間別（period）年層別（age）にASFRを計算 。
　　③期間別に年層別ASFRを集計して、地域別期間別のASFRを算定。
　＜ 計算結果の確認＞
　　①ケニアのASFR
　　　1)1950-1955年は1.52程度、2005-2010年は0.97程度。
　　　2)50年間でASFRは、0.54ほど低下している。
　　②スウェーデンのASFR
　　　1)1950-1955年は0.45程度、2005-2010年は0.38程度。
　　　2)50年間でASFRは、0.06ほど低下している。
　　③世界のASFR
　　　1)1950-1955年は1.00程度、2005-2010年は0.51程度。
　　　2)50年間でASFRは、0.49ほど低下している。
　　④まとめ
　　　・50年間で発展途上国（ケニア）のASFRは大きく低下。
　　　・一方で、先進国（スウェーデン）のASFRは殆ど横ばい。

> kenya15_49 <- kenya[kenya$age == "15-19" | kenya$age == "20-24" | kenya$age == "25-29" | kenya$age == "30-34" | kenya$age == "35-39" | kenya$age == "40-44" | kenya$age == "45-49",]
> kenya15_49$py.ASFR <- (kenya15_49$births/kenya15_49$py.women)

> kenya.ASFR <- tapply(kenya15_49$py.ASFR,kenya15_49$period,sum)
> kenya.ASFR
1950-1955 2005-2010 
1.5182820 0.9759137 

> kenya.ASFR[1] - kenya.ASFR[2]
1950-1955 
0.5423683 

> sweden15_49 <- sweden[sweden$age == "15-19" | sweden$age == "20-24" | sweden$age == "25-29" | sweden$age == "30-34" | sweden$age == "35-39" | sweden$age == "40-44" | sweden$age == "45-49",]
> sweden15_49$py.ASFR <- (sweden15_49$births/sweden15_49$py.women)

> sweden.ASFR <- tapply(sweden15_49$py.ASFR,sweden15_49$period,sum)
> sweden.ASFR
1950-1955 2005-2010 
0.4453834 0.3805528

> sweden.ASFR[1] - sweden.ASFR[2]
 1950-1955 
0.06483061

> world15_49 <- world[world$age == "15-19" | world$age == "20-24" | world$age == "25-29" | world$age == "30-34" | world$age == "35-39" | world$age == "40-44" | world$age == "45-49",]
> world15_49$py.ASFR <- (world15_49$births/world15_49$py.women)

> world.ASFR <- tapply(world15_49$py.ASFR,world15_49$period,sum)
> world.ASFR
1950-1955 2005-2010 
1.0014496 0.5087247

> world.ASFR[1] - world.ASFR[2]
1950-1955 
0.4927249

（３）合計特殊出生率（TFR）の計算
　　①ケニアのTFR
　　　1)1950-1955年は7.59程度、2005-2010年は4.88程度。
　　　2)50年間でASFRは、2.71ほど低下している。
　　②スウェーデンのTFR
　　　1)1950-1955年は2.23程度、2005-2010年は1.90程度。
　　　2)50年間でASFRは、0.32ほど低下している。
　　③世界のTFR
　　　1)1950-1955年は5.00程度、2005-2010年は2.54程度。
　　　2)50年間でASFRは、2.46ほど低下している。
　　④まとめ
　　　・50年間で発展途上国（ケニア）のASFRは大きく低下。
　　　・一方で、先進国（スウェーデン）のASFRは殆ど横ばい。
　　    ・世界全体のTFRは50年間で殆ど半減。
　　　・その理由は女性の観察人数が2.5倍の一方で出生数は1.3倍のため。

> kenya.TFR <- tapply(kenya15_49$py.ASFR*5,kenya15_49$period,sum)
> kenya.TFR
1950-1955 2005-2010 
 7.591410  4.879568 

> kenya.TFR[1] - kenya.TFR[2]
1950-1955 
 2.711841

> sweden.TFR <- tapply(sweden15_49$py.ASFR*5,sweden15_49$period,sum)
> sweden.TFR
1950-1955 2005-2010 
 2.226917  1.902764 

> sweden.TFR[1] - sweden.TFR[2]
1950-1955 
0.3241531 

> world.TFR <- tapply(world15_49$py.ASFR*5,world15_49$period,sum)
> world.TFR
1950-1955 2005-2010 
 5.007248  2.543623 

> world.TFR[1] - world.TFR[2]
1950-1955 
 2.463625

> world.women <- tapply(world$py.women,world$period,sum)
> world.women
1950-1955 2005-2010 
  6555686  16554781 

> world.women[2]/world.women[1] 
2005-2010 
 2.525256 

> world.child <- tapply(world$births,world$period,sum)
> world.child
1950-1955 2005-2010 
 488891.5  674581.3 

> world.child[2]/world.child[1]
2005-2010 
 1.379818 

> par(mfrow=c(2,2))
> barplot(world$py.women[world$period == "1950-1955"],names.arg = world$age[world$period == "1950-1955"],ylim = c(0,1600000),main="1950-55 py.women")
> barplot(world$py.women[world$period == "2005-2010"],names.arg = world$age[world$period == "2005-2010"],ylim = c(0,1600000),main="2005-10 py.women")
> barplot(world$births[world$period == "1950-1955"],names.arg = world$age[world$period == "1950-1955"],ylim = c(0,220000),main="1950-55 child")
> barplot(world$births[world$period == "2005-2010"],names.arg = world$age[world$period == "2005-2010"],ylim = c(0,220000),main="2005-10 child")

画像1

（４）粗死亡率（CDR）の計算
　　①ケニアのCDR
　　　1)1950-1955年は0.024程度、2005-2010年は0.010程度。
　　　2)50年間でCDRは、0.013ほど低下し、半減している。
　　②スウェーデンのCDR
　　　1)1950-1955年は0.0098程度、2005-2010年は0.0099程度。
　　　2)50年間でCDRは、ほぼ横ばい
　　③世界のCDR
　　　1)1950-1955年は0.019.程度、2005-2010年は0.008程度。
　　　2)50年間でCDRは、0.011ほど低下し、半減している。
　　④まとめ
　　　・50年間で発展途上国（ケニア）のASFRは大きく低下。
　　　・一方で、先進国（スウェーデン）のASFRは殆ど横ばい。　　

> kenya.CDR <- tapply(kenya$deaths,kenya$period,sum)/tapply(kenya$py.person,kenya$period,sum)
> kenya.CDR
 1950-1955  2005-2010 
0.02396254 0.01038914 

> kenya.CDR[1] - kenya.CDR[2]
1950-1955 
0.0135734 
 
> sweden.CDR <- tapply(sweden$deaths,sweden$period,sum)/tapply(sweden$py.person,sweden$period,sum)
> sweden.CDR
  1950-1955   2005-2010 
0.009844842 0.009968455 

> sweden.CDR[1] - sweden.CDR[2]
    1950-1955 
-0.0001236131 

> world.CDR <- tapply(world$deaths,world$period,sum)/tapply(world$py.person,world$period,sum)
> world.CDR
  1950-1955   2005-2010 
0.019318929 0.008166083 

> world.CDR[1] - world.CDR[2]
 1950-1955 
0.01115285

（５）年齢別死亡率（ASDR）の計算
　　①2005-10年におけるASDRは、全年齢でケニアの方が高い値である。
　　②両者の差は平均して0.013程度で、最小0.002〜最大0.048である。

> kenya$py.ASDR <- kenya$deaths/kenya$py.person
> sweden$py.ASDR <- sweden$deaths/sweden$py.person
> diff <- kenya$py.ASDR[kenya$period == "2005-2010"]-sweden$py.ASDR[sweden$period == "2005-2010"]

> summary(diff)
    Min.  1st Qu.   Median     Mean  3rd Qu.     Max. 
0.002674 0.004740 0.009518 0.013211 0.014389 0.048731 

> par(mfrow = c(1,3))
> barplot(kenya$py.ASDR[kenya$period == "2005-2010"],names.arg = kenya$age[kenya$period == "2005-2010"],ylim = c(0,0.2),main = "2005-2010 Kenya ASDR")
> barplot(sweden$py.ASDR[sweden$period == "2005-2010"],names.arg = sweden$age[sweden$period == "2005-2010"],ylim = c(0,0.2),main = "2005-2010 Sweden ASDR")
> barplot(diff,names.arg = sweden$age[sweden$period == "2005-2010"],ylim = c(0,0.2),main = "2005-2010 Sweden ASDR")

画像2

（６）ケニアの反事実的なCDRの計算
　　・反事実的なCDRは、0.013程度と実際のCDR0.010よりも高くなる。
 　　・ケニアとスウェーデンの年齢別人口割合を比較すると、スウェーデンの方が高齢者の割合が高い。年齢が上がるとケニアのASDRは、高くなる傾向にあるため、結果、反事実的なCDRが実際のCDRよりも高くなると考えられる。

> sweden$prob.py.person <- sweden$py.person/sum(sweden$py.person)
> kenya.CDR.counter <- kenya$py.ASDR[kenya$period == "2005-2010"]*sweden$prob.py.person[sweden$period == "2005-2010"]

> sum(kenya.CDR.counter)
[1] 0.01306614

> kenya.CDR[2]
 2005-2010 
0.01038914 

> par(mfrow = c(1,2))
> barplot(kenya$prob.py.person[kenya$period == "2005-2010"],names.arg = kenya$age[kenya$period == "2005-2010"],ylim = c(0,0.15),main = "2005-10 Kenya Populaiton")
> barplot(sweden$prob.py.person[sweden$period == "2005-2010"],names.arg = sweden$age[sweden$period == "2005-2010"],ylim = c(0,0.15),main = "2005-10 Sweden Populaiton")

画像3

３．練習問題を解いた感想

　・元データからいくつかの基準で部分集合化するときのコツを掴みたい。subset関数の方が楽なのか、或いは別に便利な関数があるのか調べよう。

　・tapply関数のおかげで、データセットをやたらと作らずに済む、便利。大学生の頃に、これ知っていれば、作業効率が上がった気がする。

　・初めて触れる指標は、単位や表す意味合いを直ぐに理解できず、計算結果の数字が表す意味合いを直観的に理解することに苦労する。

この記事が気に入ったらサポートをしてみませんか？