人口ピラミッドの推移

概要

人口プラミッドの推移を描く。データは国立社会保障・人口問題研究所のホームページから取得（1965年から2070年の予測まで，Excelファイルで提供されている）。

人口ピラミッドの作り方については，人口ピラミッドの作成 (2020年国勢調査)を参照。
複数年の人口ピラミッドのグラフをきれいに並べるために，patchworkパッケージを使う。

コードと実行結果

library(tidyverse)

── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
✔ dplyr     1.1.4     ✔ readr     2.1.5
✔ forcats   1.0.0     ✔ stringr   1.5.1
✔ ggplot2   3.5.1     ✔ tibble    3.2.1
✔ lubridate 1.9.3     ✔ tidyr     1.3.1
✔ purrr     1.0.2     
── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
✖ dplyr::filter() masks stats::filter()
✖ dplyr::lag()    masks stats::lag()
ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors

library(patchwork)
library(readxl)

# ファイルのダウンロード先ディレクトリ作成
dir.create("files", showWarnings = F)

# 国立社会保障・人口問題研究所のホームページからデータをダウンロード
download.file("https://www.ipss.go.jp/site-ad/TopPageData/pyramidDataPP2023J_11.xlsx",
  destfile = "files/pyramidDataPP2023J_11.xlsx",
  method = "curl"
)

# データの整理 年，年齢階級，性別，人口のlong形式に
Male <- read_excel("files/pyramidDataPP2023J_11.xlsx",
  sheet = "M", range = "B3:W110", col_names = T
)
Female <- read_excel("files/pyramidDataPP2023J_11.xlsx",
  sheet = "F", range = "B3:W110", col_names = T
)
age <- paste(c("total", seq(0, 105, 1)))

Male <- cbind(age, Male) %>%
  pivot_longer(-age, names_to = c("year")) %>%
  filter(age != "total") %>%
  mutate(
    gender = "M",
    age = as.numeric(age),
    value = -value
  )

Female <- cbind(age, Female) %>%
  pivot_longer(-age, names_to = c("year")) %>%
  filter(age != "total") %>%
  mutate(
    gender = "F",
    age = as.numeric(age)
  )

population <- rbind(Male, Female)

# 人口ピラミッドを作成する年を指定
years <- c(1965, 1980, 1995, 2010, 2040, 2070)


# 人口ピラミッドの描画
for (i in years) {
  fig <- population %>%
    filter(year == i) %>%
    ggplot(aes(x = age, y = value, fill = gender)) +
    geom_bar(stat = "identity", color = "black", linewidth = 0.1) +
    scale_x_continuous(n.breaks = 10) +
    scale_y_continuous(
      limits = c(-1250, 1250),
      breaks = seq(-1000, 1000, 500),
      labels = abs(seq(-1000, 1000, 500))
    ) +
    scale_fill_hue(
      name = "",
      labels = c("F" = "女", "M" = "男")
    ) +
    labs(title = i, y = "", x = "") +
    coord_flip() +
    theme(legend.position = "none")

  if (i == years[1]) {
    g <- fig
  } else {
    g <- g + fig
  }
}

plot(g)