ピリオド合計特殊出生率だけを見ていると政策の評価を誤ってしまう可能性があります
こんにちは、少子化研究者の茂木良平です。南デンマーク大学というところで、少子化を専門に研究しています。
毎週月曜日に少子化の現状をデータと研究知見を交えて紹介しています。
前回の記事では、少子化の現状を理解する上で一番大事な指標である、合計特殊出生率（TFR）について詳しく解説しました。TFRにはピリオドTFRとコーホートTFRの2種類あり、メディアでよく使われるのはピリオドTFRの方です。しかしそのピリオドTFRは誤解されていることが多いことを紹介しました。
今回はそれを踏まえて、ピリオドTFRのみを見ることの危険性を示していきます。
前回の簡単なまとめ
・合計特殊出生率（TFR）にはピリオドTFRとコーホートTFRの2種類ある。
・ピリオドTFRは「ある年に15歳の女性が49歳まで生存し、その年に観測された各年齢別出生率をそのまま経験した場合の、女性の平均子ども数」を意味する。メディアでよく使われる「女性が生涯産む平均子ども数」は間違い。
・コーホートTFRは「ある年に生まれた女性が生涯に産んだ平均子ども数」を意味する。
・それぞれにメリット・デメリットあるが、本当はコーホートTFRで出生行動の変化を解釈したいが、データが取りずらい＆待たなくてはならないので、ピリオドTFRを使って仮想的な値を求めている。
・ピリオドTFRの大きな欠点は、人々の子どもを産むタイミングがマクロレベルのTFRに与える効果（テンポ効果）によって反応してしまう。
ピリオドTFRだけを見ていると政策の評価を見誤ってしまう例
ピリオドTFRのみ見た場合
図1はチェコの1960年から2019年までの期間TFRの推移を表しています¹。チェコの少子化事情や、家族政策についてあまり耳慣れない方も多いと思いますが大丈夫です。ここでは、トレンドだけ見ていきます。
データソース：Human Fertility Database
注：2つの灰色の縦線は、1968年と2001年に行われた家族政策の拡大を示している。
チェコは、1966年に人口置き換え水準²を下回りましたが、その後回復し、1980年までは人口置き換え水準より高い位置を維持しました。しかし、その後減少し続け、1990年を境に急減し、1999年にはなんと1.14と非常に低いレベルになってしまいました。ちなみに1999年の日本のピリオドTFRは1.35でしたので、日本よりも低出生でした。
1999年を境に再び上昇し、2019年のピリオドTFRは1.71と高いレベルにまで回復しています。
このように、チェコはピリオドTFRの乱高下が激しい国の一つとして知られています。チェコのようなケースは特別珍しいわけではなく、スウェーデンも同様です。参考までに図を記事の最後に載せておきます。
チェコは、1968年と2001年に家族政策の拡大（図1の灰色の縦線）が行われました。
この2つの家族政策の拡大とピリオドTFRのトレンドを見ると、家族政策の拡大に伴いピリオドTFRが上昇しているように見えます。
これは正しい解釈でしょうか？
ピリオドTFRとコーホートTFRを見た場合
図1にコーホートTFRを追加してみます。コーホートTFRはある年に生まれた人が生涯に持つ平均子ども数を意味しており、ピリオドTFRとは異なりテンポ効果（人々の子どもを産むタイミングがマクロレベルのTFRに与える効果）を受けません。
データソース：Human Fertility Database
注：コーホートTFRは、1960年から1999年のピリオド平均出生年齢の平均値（チェコ：25歳）を各出生年に足して、出生年から年次に近似している³。例えば、1980年のピリオドTFRは1952年生まれのコーホートTFRと比較している。これは、1952年生まれの人は1980年に平均出生年齢を迎えるためである。
図2からわかる通り、ピリオドTFRでみられた激しい増減はコーホートTFRでは見られず、また1968年と2001年の家族政策拡大に伴う出生率の増加は見られません(2001年の家族政策拡大の効果を測るのは早すぎますが)。
この比較から、ピリオドTFRの激しい増減は、テンポ効果によってもたらされていると示唆されます。また、図1で見られた、2つの家族政策の拡大後の増加はみかけの増加で、この家族政策の拡大は子どもを産むタイミングを早めた可能性はあるが、1人の女性が産む平均子ども数を増加させたわけではないということも示唆されます。
つまり、ピリオドTFRのみから様々な政策の評価、また時代の変化を見ることは間違った評価につながる可能性があります。
日本ではどうか？
幸い（？）、日本はチェコのようにピリオドTFRの増減がそれほど激しくありません。ピリオドTFRが急減したのは丙午の年だけで、あとは基本的に減少を続けてます。
データソース：Human Fertility Database
そのため、ピリオドTFRとコーホートTFRは数値は異なりますが、似たようなトレンドを持っています。しかし、ピリオドTFRがテンポ効果に反応してしまうことは同じです。
例えば、2005年以降のピリオドTFRの増加はどのように判断すればよいでしょうか？これは、1人の女性が持つ平均子ども数が増えたことを意味するでしょうか？それともチェコで見られたようなタイミングの変化に反応した見かけ上の増加でしょうか？
次回はここら辺を詳しく紹介したいと思います。
データソース：Human Fertility Database
まとめ
チェコやスウェーデンのようにピリオドTFRの増減が激しい国は、ピリオドTFRのみを見て、少子化事情を判断するのは誤った解釈に繋がりやすい。
チェコの1968年の2001年の家族政策の拡大は、ピリオドTFRを増加させているように見える。しかし、コーホートTFRと比較すると、そういった解釈はできず、ピリオドTFRのテンポ効果による影響が大きいと思われる。
日本は、ピリオドTFRの増減が比較的激しくないので、チェコのような影響は少ないと思われる。しかし、テンポ効果の影響は無視できない。
ピリオドTFRだけでなく、コーホートTFRも併せて少子化の現状を解釈する必要がある。
この記事をちょっとでも面白いと思ってくれた方は下にある「スキ」ボタン、SNSでのシェアよろしくお願いします。とても励みになります！ご質問はこの記事へのコメント、もしくはtwitterまでお気軽にご連絡ください（全部は返信できませんが、次回の記事の参考にさせていただきます）。また記事執筆やインタビューの依頼はメールアドレスrymo[at]sdu.dkまでお願いします。
少子化に関する他の記事は以下のマガジン（無料です）にまとめておりますので、ご覧にください。フォローもお願いします！
注
1）この記事は、国際連合人口基金が刊行しているWorking paperを基にした。
2）人口置き換え水準とは、人口が長期的に維持される出生率の水準を意味する。現代の日本だと約2.1とされる。
3）今回は簡単な近似の方法を用いたが、より精緻な近似を行う場合は、Schoen (2022)が提示している方法がいいと思う。
library(tidyverse)
library(openxlsx)
Mycol <- c("#08306B", "#238B45", "#FD8D3C", "#D4B9DA", "#FFEDA0")
#----- read data
# data is from Human Fertility Database. Accessed on 25/05/2023
ptfr <- read.xlsx("TFR.xlsx", sheet = "Total fertility rates", startRow = 2)[-1, ]
ctfr <- read.xlsx("CCF.xlsx", sheet = "Completed cohort fertility", startRow = 2)[-1, ]
# Accessed on 27/07/2023
adjtfr <- read.xlsx("adjTFR.xlsx", sheet = "Tempo-adjusted TFR", startRow = 2)[-1, ]
# Accessed on 02/08/2023
pmab <- read.xlsx("MAB.xlsx", sheet = "Mean age at birth", startRow = 2)[-1, ]
#----- merge all data
dptfr <- ptfr %>%
as.data.frame() %>%
rename(year = COUNTRY) %>%
gather(key = country, value = ptfr, -year) %>%
mutate(ptfr = as.numeric(as.character(ptfr)),
ptfr = ifelse(ptfr == 0, NA, ptfr),
year = as.numeric(as.character(year)))
mean_mab <- pmab %>%
as.data.frame() %>%
rename(year = COUNTRY) %>%
gather(key = country, value = mab, -year) %>%
mutate(mab = as.numeric(as.character(mab)),
mab = ifelse(mab == 0, NA, mab),
year = as.numeric(as.character(year))) %>%
filter(year %in% 1960:1999) %>%
group_by(country) %>%
summarise(mean_mab = round(mean(mab, na.rm = T)))
dctfr <- ctfr %>%
as.data.frame() %>%
rename(cohort = COUNTRY) %>%
gather(key = country, value = ctfr, -cohort) %>%
mutate(ctfr = as.numeric(as.character(ctfr)),
ctfr = ifelse(ctfr == 0, NA, ctfr),
cohort = as.numeric(as.character(cohort))) %>%
left_join(mean_mab, by = c("country")) %>%
mutate(year = cohort + mean_mab)
dadjtfr <- adjtfr %>%
as.data.frame() %>%
rename(year = COUNTRY) %>%
gather(key = country, value = adjtfr, -year) %>%
mutate(adjtfr = as.numeric(as.character(adjtfr)),
adjtfr = ifelse(adjtfr == 0, NA, adjtfr),
year = as.numeric(as.character(year)))
d_3tfr <- dptfr %>%
left_join(dctfr, by = c("country", "year")) %>%
left_join(dadjtfr, by = c("country", "year")) %>%
gather(key = index, value = tfr, -c(year, country, cohort, mean_mab))
#----- figure
# Czechia
# only period TFR
d_3tfr %>%
filter(country == "Czechia",
index == "ptfr") %>%
mutate(country = ifelse(country == "Czechia", "チェコ", "NA"),
index = ifelse(index == "ptfr", "ピリオドTFR", "NA")) %>%
ggplot(aes(x = year, y = tfr)) +
geom_vline(xintercept = 1968, colour = "grey80", size = 5) +
geom_vline(xintercept = 2001, colour = "grey80", size = 5) +
geom_line(size = 1.2, colour = Mycol[3]) +
annotate("segment", x = 1970, y = 1.8, xend = 1975, yend = 2.3,
arrow = arrow(), size = 1.1) +
annotate("segment", x = 2002, y = 1, xend = 2009, yend = 1.35,
arrow = arrow(), size = 1.1) +
labs(x = "年次", y = "合計特殊出生率",
caption = "データソース：Human Fertility Database. 作成者：茂木良平") +
theme_minimal(base_family = "HiraKakuPro-W3") +
theme(axis.text = element_text(size = 12),
axis.title = element_text(size = 15),
legend.position = "top",
legend.title = element_blank(),
legend.text = element_text(size = 12),
strip.text.x = element_text(size = 12))
# both period and cohort TFR
d_3tfr %>%
filter(country == "Czechia",
index != "adjtfr") %>%
mutate(country = ifelse(country == "Czechia", "チェコ", "NA"),
index = case_when(index == "ctfr" ~ "コーホートTFR",
index == "ptfr" ~ "ピリオドTFR"),
index = factor(index, levels = c("コーホートTFR", "ピリオドTFR"))) %>%
ggplot(aes(x = year, y = tfr, group = index, colour = index)) +
geom_vline(xintercept = 1968, colour = "grey80", size = 5) +
geom_vline(xintercept = 2001, colour = "grey80", size = 5) +
geom_line(size = 1.2) +
labs(x = "年次", y = "合計特殊出生率",
caption = "データソース：Human Fertility Database. 作成者：茂木良平") +
scale_colour_manual(values = c(Mycol[1], Mycol[3])) +
theme_minimal(base_family = "HiraKakuPro-W3") +
theme(axis.text = element_text(size = 12),
axis.title = element_text(size = 15),
legend.position = "top",
legend.title = element_blank(),
legend.text = element_text(size = 12),
strip.text.x = element_text(size = 12))
# Japan
d_3tfr %>%
filter(country == "Japan",
index != "adjtfr") %>%
mutate(country = ifelse(country == "Japan", "日本", "NA"),
index = case_when(index == "ctfr" ~ "コーホートTFR",
index == "ptfr" ~ "ピリオドTFR"),
index = factor(index, levels = c("コーホートTFR", "ピリオドTFR"))) %>%
ggplot(aes(x = year, y = tfr, group = index, colour = index)) +
geom_line(size = 1.2) +
labs(x = "年次", y = "合計特殊出生率",
caption = "データソース：Human Fertility Database. 作成者：茂木良平") +
scale_colour_manual(values = c(Mycol[1], Mycol[3], Mycol[4])) +
theme_minimal(base_family = "HiraKakuPro-W3") +
theme(axis.text = element_text(size = 12),
axis.title = element_text(size = 15),
legend.position = "top",
legend.title = element_blank(),
legend.text = element_text(size = 12),
strip.text.x = element_text(size = 12))
# Czechia and Sweden
d_3tfr %>%
filter(country %in% c("Czechia", "Sweden"),
index != "adjtfr") %>%
mutate(country = ifelse(country == "Czechia", "チェコ", "スウェーデン"),
index = ifelse(index == "ctfr", "コーホートTFR", "ピリオドTFR")) %>%
ggplot(aes(x = year, y = tfr, group = index, colour = index)) +
facet_wrap(~ country) +
geom_line(size = 1.2) +
labs(x = "年次", y = "合計特殊出生率",
caption = "データソース：Human Fertility Database. 作成者：茂木良平") +
scale_colour_manual(values = c(Mycol[1], Mycol[3])) +
theme_minimal(base_family = "HiraKakuPro-W3") +
theme(axis.text = element_text(size = 12),
axis.title = element_text(size = 15),
legend.position = "top",
legend.title = element_blank(),
legend.text = element_text(size = 12),
strip.text.x = element_text(size = 12))サポートしていただいたお金は、研究費に使わせていただきます！