まず、「国勢調査の配偶関係データを R で取得する」で作成した、都道府県別の婚姻状況データを読み込みます。このデータは、15歳以上の日本の居住者を、都道府県毎、年齢毎、性別毎に、「未婚」「離別」「死別」「配偶関係不詳」「有配偶」に分けて記載しています。一般的には未婚、既婚の2分類を使いますが、国勢調査では婚姻関係を結んだ後の離別（離婚）と死別（配偶者の死亡）も区別しています。

census <- read.csv('prefs.csv')
attach(census)
census$age <- as.integer(sub('歳.*', '', age))
census$area_code <- as.factor(area_code)
census$area <- ordered(area, levels=unique(area))
census$marital_status <- ordered(
  marital_status,
  levels=rev(c('未婚', '離別', '死別', '配偶関係「不詳」', '有配偶'))
)
detach()

このデータは、全人口と、日本人の人口の両方を持っているので、外国人比率も参考までに押さえておきましょう。

num_of_all <- sum(census[census$nationality=='総数（国籍）',]$value, na.rm=T)
num_of_japanese <- sum(census[census$nationality=='日本人',]$value, na.rm=T)
print(sprintf(
  '全人口は %s 人、外国人居住者は %s 人で、全体の %f %% を占める。',
  prettyNum(num_of_all, big.mark=','),
  prettyNum(num_of_all - num_of_japanese, big.mark=','),
  (num_of_all - num_of_japanese) / num_of_all * 100
))
=> [1] "全人口は 109,754,177 人、外国人居住者は 2,129,711 人で、全体の 1.940437 % を占める。"

全人口1.1億というのは少ないと思われるでしょうが、このデータには15才未満が含まれていないのです。婚姻関係を追うものですから。

15歳で結婚

参考までに、15〜18才の婚姻状態を調べてみましょう。

census %>%
dplyr::filter(age <= 18, nationality == '総数（国籍）', marital_status == '有配偶') %>%
  na.omit() %>%
  group_by(gender, age) %>%
  summarize(population=sum(value)) %>%
  spread(gender, population)

15歳の女性が144人、男性が86人も配偶者を持っているのですね。民法では女性16歳、男性18歳から婚姻が認められますが、国勢調査の「有配偶」は、届出の有無に関係なく、実態を表しています。事実上、周囲から夫婦であると認められている状態です。一般的な言葉で言えば「事実婚」です。

15歳で結婚というのは地方の風習のようなものがあるのではないかと思ったので、抽出してみます。

census %>%
dplyr::filter(age == 15, nationality == '総数（国籍）', marital_status == '有配偶') %>%
  na.omit() %>%
  select(gender, age, area, value) %>%
  spread(gender, value) %>%
  mutate(sum=ifelse(is.na(女), 0, 女) + ifelse(is.na(男), 0, 男)) %>%
  arrange(desc(sum))

そんなことはなく、大都市に多かった。。。ちなみに日本人だけに限定しても、それほど大きくは変わりません。ふと「13歳で結婚。14歳で出産。恋は、まだ知らない」を思い出しました。どういう事情なのかはわからないけど、そういう人生もありですよね。

人口ピラミッド

さて、本題に戻って、人口ピラミッドを描く為のデータを準備しましょう。100歳以上がひとまとめにされていて非連続なため、99歳までに限定します。また、描画の都合上、男性をマイナス値とします。

data <- census %>%
  dplyr::filter(nationality == '総数（国籍）', age != 100) %>%
  group_by(area, gender, age, marital_status) %>%
  summarize(population=sum(value * ifelse(gender == '男', -1, 1), na.rm=T))

このデータを使って人口ピラミッドを描いてみます。

breaks_y <- seq(-1.2*10**6, 0.9*10**6, 3*10**5)
data %>%
  group_by(age, gender) %>%
  summarize(population=sum(population)) %>%
  ggplot(aes(age, population, fill=gender)) +
  geom_bar(stat='identity') +
  coord_flip() +
  scale_fill_discrete(breaks=c('男', '女')) +
  scale_x_continuous(breaks=seq(20, 100, 10)) +
  scale_y_continuous(breaks=breaks_y, labels=abs(breaks_y))

上記の図で49歳が少ないのは、江戸時代の言い伝え「丙午（ひのえうま）の女は気性が激しく夫の命を縮める」により1966年生まれが減ったため、69〜70歳が少ないのは敗戦により1945年、1946年生まれが減ったため、76歳が少ないのは日中戦争の動員により1939年生まれが減ったためです。

ちなみに丙午は60年ごとにやってきます。前々回の1906年の出生率は前年より4%減少、前回の1966年は前年より25%減少しています。次は2026年。話題になるとしたら2025年です。この時代になっても、人々は気にするのでしょうか。

婚姻状態の人口ピラミッド

人口ピラミッドを婚姻状態で分けてみましょう。前の図と同様、男性を左側、女性を右側にプロットします。

data %>%
  group_by(age, gender, marital_status) %>%
  summarize(population=sum(population)) %>%
  arrange(marital_status) -> x
x %>%
  ggplot(aes(age, population, fill=marital_status)) +
  geom_bar(stat='identity') +
  geom_hline(yintercept=0, color='white') +
  coord_flip() +
  scale_x_continuous(breaks=seq(20, 100, 10)) +
  scale_y_continuous(breaks=breaks_y, labels=abs(breaks_y))

20歳以上の未婚者数は、だいたいどの年代を見ても左右非対称で男性の方が多い「男余り」の状態であることがわかります。また、離別者数は女性が多くなっています。離別数そのものは基本的に男女同数なので、男性は離別後に再婚する割合が多いと考えられます。厚労省の離婚統計によると、妻が子を引き取る割合が夫に比べて数倍多いので、この女性の離別者の中には相当数のシングルマザーが含まれていると推測されます。

婚姻状態を比率で表すと以下のようになります。

結婚のピークは27歳

上記の図では男女の比較がしにくいので、未婚率を男女で比較できるようにしてみましょう。

data %>%
  group_by(age, gender, marital_status) %>%
  summarize(population=sum(population)) %>%
  spread(marital_status, population) %>%
  mutate(
    全体=未婚 + 離別 + 死別 + `配偶関係「不詳」` + 有配偶,
    未婚率=未婚/全体
  ) -> unmarried_ratio
unmarried_ratio %>%
  ggplot(aes(age, 未婚率, color=gender)) +
  geom_line() +
  scale_x_continuous(breaks=seq(20, 100, 10))

男女とも20代後半が結婚のピーク、35歳以降は結婚のペースが緩やかになります。75歳あたりで男性の未婚率が女性を下回るのは、寿命によるものです。

ピークの年齢を明示するために、変化量をグラフにしてみます。

unmarried_ratio %>%
  select(age, gender, 未婚率) %>%
  spread(gender, 未婚率) %>%
  ungroup %>%
  mutate(女性未婚率変化=lag(女)-女, 男性未婚率変化=lag(男)-男) %>%
  select(age, 男性未婚率変化, 女性未婚率変化) %>%
  gather(gender, 未婚率変化, -age) %>%
  mutate(gender=sub('性未婚率変化', '', gender)) %>%
  na.omit() -> unmarried_ratio_change
unmarried_ratio_change %>% spread(gender, 未婚率変化)
unmarried_ratio_change %>%
  ggplot(aes(age, 未婚率変化, color=gender)) +
  geom_line() +
  scale_x_continuous(breaks=seq(20, 100, 10))

男女とも結婚のピークは27歳で、女性で7.5%程度、男性で6%程度が結婚しています。35歳を超えると、10代で結婚するのと同程度の年2%程度になり、40歳を超えると年1%未満になることがわかります。

男余り

20歳から59歳に絞って男女の未婚者数の差を見てみましょう。

data %>%
  dplyr::filter(marital_status == '未婚', age >= 20, age <= 59) %>%
  group_by(age) %>%
  summarise(diff=abs(sum(population[gender == '男'])) - sum(population[gender == '女'])) -> x
x %>% mutate(range=as.integer(age/10) * 10) %>% group_by(range) %>% summarize(sum=sum(diff))
x %>%
  ggplot(aes(age, diff)) +
  geom_bar(stat='identity')

20代の未婚居住者は、男性が女性より55万人、30代では90万人多くなっています。これを都道府県毎にプロットしてみましょう。ただし、高校卒業後の推移を見るため、範囲を若年層に広げて15〜59歳にします。

data %>%
  dplyr::filter(marital_status == '未婚', age >= 15, age <= 59) %>%
  group_by(area, age) %>%
  summarise(diff=-sum(population[gender == '男']) - sum(population[gender == '女'])) -> x
x %>% mutate(range=as.integer(age/10)*10) %>% group_by(area, range) %>% summarize(diff=sum(diff))
x %>%
  ggplot(aes(age, diff)) +
  geom_bar(stat='identity') +
  facet_wrap(~area) +
  theme(axis.text=element_blank(), axis.ticks=element_blank())

男性が余っているのは、ほとんど東京、神奈川、千葉、埼玉といった首都圏と、愛知であることがわかります。y軸を各都道府県毎に調整すると、以下のようになります。

x %>%
  ggplot(aes(age, diff)) +
  geom_bar(stat='identity') +
  facet_wrap(~area, scale='free_y') +
  theme(axis.text=element_blank(), axis.ticks=element_blank())

全体的に男余りであるものの、地方では20代前半の男性が足りない、もしくは女性と均衡しています。これは、地方の男性が高校卒業後に地元を離れ、大都市に移動することによるものだと考えられます。特に九州と奈良県、岡山県、兵庫県で顕著です。20代前半の女性と結婚したければ、これらの県にUターン、Iターンするといい、でしょうか。

その一方で東京を取り巻く神奈川、千葉、埼玉では一貫して20代、30代の男性未婚者が増え続けています。これは、地方からの男性流出の受け皿として機能しているものと考えられます。