2024年6月7日金曜日

合計特殊出生率(2)

合計特殊出生率(1)からの続き

去年の今ごろ,奥村晴彦さんの合計特殊出生率Rプログラムを写経していた。すっかり忘れていたけれど,2023年の新しい合計特殊出生率が過去最低の1.20人を記録したいうニュースで思い出すことになった。

都道府県別でみれば,東京都の0.99や北海道の1.06をはじめ,大都市部や東北地方で低く,沖縄の1.60を筆頭に,九州,山陰,北陸などで高い。

今年は,コマンドラインで実行すべく,Rプログラムを修正した。あいかわらず日本語表示でつまづいたので,ChatGPT-4oに聞きながら試行錯誤した結果,何とか解決できた。なお,スタートを自分が生まれた1953年にしてみた。

修正したRプログラムのtfr.rの内容(注:remove \ before copy and paste)は

library(showtext)

font_add("Hiragino", "/System/Library/Fonts/ヒラギノ角ゴシック W3.ttc")

showtext_auto()


X <- read.table('/Users/koshi/Desktop/birth.txt', header = TRUE)

par(family = "Hiragino")  # 利用可能なフォントを指定

plot(X\$年, X\$合計特殊出生率, type="o", pch=16, xlab="", ylab="")

t = c(range(X\$合計特殊出生率), X\$合計特殊出生率[length(X[,1])])

axis(4, t, t)

title("合計特殊出生率", line=0.5)

#title("Total Fertility Rate", line=0.5)


# x軸とy軸のメモリの位置を手動で指定

x_ticks <- pretty(X$年, 15)  # 15個のメモリを生成

y_ticks <- pretty(X$合計特殊出生率, 16)  # 16個のメモリを生成


# x軸に対してグリッド線を描画

for (i in x_ticks) {

  abline(v = i, col = "lightgray", lty = "dotted")

}


# y軸に対してグリッド線を描画

for (i in y_ticks) {

  abline(h = i, col = "lightgray", lty = "dotted")

}

これで,Rscript tfr.r とすると,pdfの出力,Rplots.pdf が得られる。なお,showtextというライブラリは,コマンドラインで R として立ち上げたプロンプトに,install.packages("extrafont") としてインストールしておく。また,データは birth.txt にあらかじめ入れてある。

年    出生数 合計特殊出生率

1953 1868040           2.70

1954 1769580           2.48

1955 1730692           2.37

1956 1665278           2.22

1957 1566713           2.04

1958 1653469           2.11

1959 1626088           2.04

1960 1606041           2.00

1961 1589372           1.96

1962 1618616           1.98

1963 1659521           2.01

1964 1716761           2.05

1965 1823697           2.14

1966 1360974           1.58

1967 1935647           2.23

1968 1871839           2.13

1969 1889815           2.13

1970 1934239           2.13

1971 2000973           2.16

1972 2038682           2.14

1973 2091983           2.14

1974 2029989           2.05

1975 1901440           1.91

1976 1832617           1.85

1977 1755100           1.80

1978 1708643           1.79

1979 1642580           1.77

1980 1576889           1.75

1981 1529455           1.74

1982 1515392           1.77

1983 1508687           1.80

1984 1489780           1.81

1985 1431577           1.76

1986 1382946           1.72

1987 1346658           1.69

1988 1314006           1.66

1989 1246802           1.57

1990 1221585           1.54

1991 1223245           1.53

1992 1208989           1.50

1993 1188282           1.46

1994 1238328           1.50

1995 1187064           1.42

1996 1206555           1.43

1997 1191665           1.39

1998 1203147           1.38

1999 1177669           1.34

2000 1190547           1.36

2001 1170662           1.33

2002 1153855           1.32

2003 1123610           1.29

2004 1110721           1.29

2005 1062530           1.26

2006 1092674           1.32

2007 1089818           1.34

2008 1091156           1.37

2009 1070036           1.37

2010 1071305           1.39

2011 1050807           1.39

2012 1037232           1.41

2013 1029817           1.43

2014 1003609           1.42

2015 1005721           1.45

2016  977242           1.44

2017  946146           1.43

2018  918400           1.42

2019  865239           1.36

2020  840835           1.33

2021  811622           1.30

2022  770759           1.26

2023  727277           1.20

図:1953-2023  の合計特殊出生率の推移


0 件のコメント:

コメントを投稿