「高齢層と若者」というとらえ方の問題点を示唆するグラフ

このRidgeline Plotは、実際のデータではなく、シミュレーションによるもの。

```{r}
# ----------------------------------------------------
# 1. 必要なパッケージのインストールと読み込み
# ggridgesパッケージは、分布を重ねて表示するリッジラインプロットに必要です。
# ----------------------------------------------------
# install.packages(c("ggplot2", "ggridges", "dplyr")) # 必要に応じてコメントを外して実行
library(ggplot2)
library(ggridges)
library(dplyr)

# ----------------------------------------------------
# 2. 所得分布のシミュレーションデータ生成
# (単位: 万円/年)
# ----------------------------------------------------

# 現役世代: 20代
# 所得平均は中程度だが、バラツキはやや小さめ
set.seed(42)
income_20s <- data.frame(
  Generation = factor("現役世代 (20代)", levels = c("現役世代 (20代)", "現役世代 (40代)", "高齢層 (70代)")),
  Income_Millions = round(rnorm(n = 500, mean = 3.5, sd = 1.0), 1)
)

# 現役世代: 40代
# 所得平均は最も高いが、格差も存在
income_40s <- data.frame(
  Generation = factor("現役世代 (40代)", levels = c("現役世代 (20代)", "現役世代 (40代)", "高齢層 (70代)")),
  Income_Millions = round(rnorm(n = 500, mean = 6.0, sd = 2.0), 1)
)

# 高齢層: 70代
# 所得平均は低いが、資産家（高所得）も多く、最もバラツキが大きい
# (平均3.0の年金層と、平均8.0の資産家層を混合)
income_70s_low <- rnorm(n = 400, mean = 3.0, sd = 1.0)
income_70s_high <- rnorm(n = 100, mean = 8.0, sd = 2.5) # 豊かな高齢層を表現
income_70s <- data.frame(
  Generation = factor("高齢層 (70代)", levels = c("現役世代 (20代)", "現役世代 (40代)", "高齢層 (70代)")),
  Income_Millions = round(c(income_70s_low, income_70s_high), 1)
)

# 全データを結合
simulated_data <- bind_rows(income_20s, income_40s, income_70s) %>%
  # マイナスの所得をクリッピング（現実的な範囲に収める）
  filter(Income_Millions > 0)


# ----------------------------------------------------
# 3. リッジラインプロットの作成 (世代内のグラデーションを表現)
# ----------------------------------------------------
ggplot(simulated_data, aes(x = Income_Millions, y = Generation, fill = Generation)) +
  
  # リッジラインプロットの描画
  geom_density_ridges(
    alpha = 0.7,      # 透明度
    scale = 3,        # 世代間の重なりの度合い (大きくすると分布の山が大きくなる)
    rel_min_height = 0.01 # 非常に小さな密度値の表示を省略
  ) +
  
  # ラベルとタイトルの設定
  labs(
    title = "世代別の所得分布のシミュレーション",
    subtitle = "「高齢層」と「現役世代」内の大きなグラデーションを示す",
    x = "年収 (百万円)",
    y = "世代"
  ) +
  
  # X軸の調整 (所得0から上限を設定)
  scale_x_continuous(
    limits = c(0, 15), # 年収0万円から1500万円の範囲で表示
    breaks = seq(0, 15, by = 2.5)
  ) +
  
  # カラーパレットの指定 (任意)
  scale_fill_manual(values = c("現役世代 (20代)" = "#1f77b4", 
                               "現役世代 (40代)" = "#ff7f0e", 
                               "高齢層 (70代)" = "#2ca02c")) +
  
  # ユーザー指定のテーマ（日本語フォント対応）の適用
  theme_minimal(base_family="HiraKakuProN-W3") +
  
  # 凡例を非表示に
  theme(legend.position = "none")

# ----------------------------------------------------
# 実行結果:
# グラフを見ると、高齢層(70代)の分布は幅広く、一部は40代の平均を上回る所得を持っています。
# このように、「高齢層」対「若者」ではなく、「所得」という軸で見るとグラデーションがあることが分かります。
# ----------------------------------------------------
```