見出し画像

【高等学校 Rを使ったデータ分析 no.11】どんなデータを比較する?

(前回の続き)

 続けて, 公共交通機関を使った通勤・通学率のデータを以下から用意した。
利用交通手段の種類数・利用交通手段,常住地又は従業地・通学地別通勤者・通学者数(15歳以上) 
 このうち, 各都道府県「鉄道・電車」「乗合バス」「勤め先・学校のバス」を利用し, かつ「自家用車」を併用しないデータを抜き出し, 全体で割った値を「D公共交通機関通勤通学率」とする。さらに「徒歩のみ」「自転車のみ」のデータを全体で割った値を「E徒歩自転車通勤通学率」とすることとした。(Rであれば, 必要なデータをスクリプトの中から自在に取り出し集計・分析できるのであろうが, 今回は手動で)

 ここで, この二つのデータの箱ひげ図を作成した。

図3

 参考までに, Geminiを利用し作成したRスクリプトである。(ほとんど修正を加えていない)

# 必要なライブラリを読み込む
# 'tidyverse'はデータの読み込み、整形、可視化に便利です
# インストールされていない場合は、install.packages("tidyverse") を実行してください
if (!requireNamespace("tidyverse", quietly = TRUE)) {
  install.packages("tidyverse")
}
library(tidyverse)

# --- 1. データの読み込み ---
data_pub_trans <- read_excel("D公共交通機関通勤通学率.xlsx", skip=1,range = "A1:B48")
data_walk_bike <- read_excel("E徒歩自転車通勤通学率.xlsx", skip=1,range = "A1:B48")

# 確認のためにデータ構造を表示
print(head(data_pub_trans))
print(head(data_walk_bike))

# --- 2. データの前処理と整形 ---

# 列名を分かりやすいものに統一し、必要な列だけを選択
data_pub_trans_tidy <- data_pub_trans %>%
  select(都道府県, 公共交通機関通勤通学率) %>%
  rename(Rate = 公共交通機関通勤通学率) %>%
  mutate(Category = "公共交通機関")

data_walk_bike_tidy <- data_walk_bike %>%
  select(都道府県, 徒歩自転車通勤通学率) %>%
  rename(Rate = 徒歩自転車通勤通学率) %>%
  mutate(Category = "徒歩・自転車")

# 2つのデータを結合(縦に連結)
combined_data <- bind_rows(data_pub_trans_tidy, data_walk_bike_tidy)

# Rate列が文字型になっている可能性を考慮し、数値型(double)に変換
combined_data <- combined_data %>%
  mutate(Rate = as.numeric(Rate))

# --- 3. 要約統計量の計算と表の作成 ---

# group_by()とsummarise()で、最大、最小、中央値、四分位数を計算
summary_stats <- combined_data %>%
  group_by(Category) %>%
  summarise(
    最小値 = min(Rate, na.rm = TRUE),
    第一四分位数_Q1 = quantile(Rate, 0.25, na.rm = TRUE),
    中央値_Q2 = median(Rate, na.rm = TRUE),
    第三四分位数_Q3 = quantile(Rate, 0.75, na.rm = TRUE),
    最大値 = max(Rate, na.rm = TRUE)
  )

# 表の表示
print("✅ 要約統計量 (都道府県別通勤通学率)")
print(summary_stats)


# --- 4. 並列箱ひげ図の作成 ---

# ggplot2を使用して箱ひげ図を作成
boxplot_plot <- combined_data %>%
  ggplot(aes(x = Category, y = Rate, fill = Category)) +
  # 箱ひげ図を追加
  geom_boxplot() +
  # 個別のデータ点(都道府県)を重ねて表示(オプション)
  geom_jitter(color = "black", size = 0.8, alpha = 0.6, width = 0.1) +
  # タイトルと軸ラベルの設定
  labs(
    title = "公共交通機関と徒歩・自転車の通勤通学率の比較 (都道府県別)",
    x = "利用手段",
    y = "通勤通学率",
    fill = "利用手段"
  ) +
  # スケールを見やすくするため、Y軸をパーセンテージ表記に近い形にする
  scale_y_continuous(labels = scales::percent) +
  # テーマ設定
  theme_minimal() +
  # 凡例のタイトルを非表示にする
  theme(legend.position = "none")

# プロットの表示
print("📊 並列箱ひげ図")
print(boxplot_plot)

# グラフをPNGファイルとして保存 (オプション)
ggsave("boxplot_plot.png", plot = boxplot_plot, width = 8, height = 6, units = "in")

 最後にe-Statより, 各都道府県の「F道路実延長」と「G人口密度(総人口を面積で割った)」を加え, 散布図・相関行列を作成した。

図4
# 必要なライブラリを読み込む
# GGally: 散布図行列(ペアプロット)を作成するための主要なパッケージ
# tidyverse: データ操作と整形に役立つパッケージ群
# scales: 軸ラベルをパーセンテージ形式にするために使用
if (!requireNamespace("tidyverse", quietly = TRUE)) {
  install.packages("tidyverse")
}
if (!requireNamespace("GGally", quietly = TRUE)) {
  install.packages("GGally")
}
if (!requireNamespace("scales", quietly = TRUE)) {
  install.packages("scales")
}

library(tidyverse)
library(GGally)
library(scales)

# --- 1. データの読み込み ---

# ファイル名
file_car_ownership <- "A自動車保有台数.xlsx"
file_road_length <- "F道路実延長.xlsx"
file_pop_density <- "G人口密度.xlsx"
file_pub_trans <- "D公共交通機関通勤通学率.xlsx"
file_walk_bike <- "E徒歩自転車通勤通学率.xlsx"

# 各Excelファイルを読み込み、不要なヘッダー行をスキップし、列名が2行目以降にあることを考慮
data_car <- read_excel(file_car_ownership, skip=1,range = "A1:B48") %>% select(都道府県, 自動車保有台数)
data_road <- read_excel(file_road_length, skip=1,range = "A1:B48") %>% select(都道府県, 道路実延長)
data_pop <- read_excel(file_pop_density, skip=1,range = "A1:B48") %>% select(都道府県, 人口密度)
data_pub_trans <- read_excel(file_pub_trans, skip=1,range = "A1:B48") %>% select(都道府県, 公共交通機関通勤通学率)
data_walk_bike <- read_excel(file_walk_bike, skip=1,range = "A1:B48") %>% select(都道府県, 徒歩自転車通勤通学率)

# --- 2. データの結合と整形 ---

# 全てのデータを「都道府県」をキーとして結合(ジョイン)
combined_data <- data_car %>%
  inner_join(data_road, by = "都道府県") %>%
  inner_join(data_pop, by = "都道府県") %>%
  inner_join(data_pub_trans, by = "都道府県") %>%
  inner_join(data_walk_bike, by = "都道府県")

# 全ての測定値を数値型 (numeric) に変換
# エラーを避けるため、文字型が入る可能性のある列を処理
df_for_plots <- combined_data %>%
  # 最初の列('都道府県')を除外し、全てを数値に変換
  mutate(across(-都道府県, as.numeric)) %>%
  # 列名を短縮し、見やすくする
  rename(
    自動車 = 自動車保有台数,
    道路 = 道路実延長,
    人口密度 = 人口密度,
    公共交通 = 公共交通機関通勤通学率,
    徒歩自転車 = 徒歩自転車通勤通学率
  ) %>%
  # 「都道府県」列も除外して、数値データのみのデータフレームを作成
  select(-都道府県)

# NA値(欠損値)を含む行を除去(相関行列の計算に必須)
df_for_plots <- na.omit(df_for_plots)

# --- 2. 散布図相関行列のカスタム関数定義 ---

# Rのマッピングオブジェクトから変数名を文字列として安全に抽出するヘルパー関数
get_var_name <- function(mapping_obj) {
  # mapping$x や mapping$y から変数名を文字列として取得
  as.character(mapping_obj)[2]
}

# 1. 右上 (Upper): 散布図のみ (回帰直線/相関係数なし)
my_scatter_only <- function(data, mapping, ...) {
  # エラー対策:変数名を文字列で取得
  x_var <- get_var_name(mapping$x)
  y_var <- get_var_name(mapping$y)
  
  ggplot(data = data, mapping = aes_string(x = x_var, y = y_var)) +
    geom_point(alpha = 0.7, color = "steelblue") +
    theme_minimal() +
    # 軸の目盛を非表示にして、プロットをシンプルにする
    theme(axis.title = element_blank())
}

# 2. 左下 (Lower): シンプルな相関係数のみの表示
my_cor_text <- function(data, mapping, method = "pearson", digits = 2, ...) {
  # エラー対策:変数名を文字列で取得
  x_var <- get_var_name(mapping$x)
  y_var <- get_var_name(mapping$y)
  
  r <- cor(data[[x_var]], data[[y_var]], method = method, use = "complete.obs")
  text_label <- paste0("R = ", format(r, digits = digits))
  
  # 相関係数の値に応じてテキストの色を設定
  text_color <- ifelse(abs(r) >= 0.7, "red", ifelse(abs(r) >= 0.3, "darkblue", "black"))
  
  ggplot(data = data, mapping = mapping) +
    annotate("text", x = 0.5, y = 0.5, label = text_label, 
             color = text_color, size = 5, fontface = "bold") +
    theme_void()
}

# 3. 対角線(Diagonal): ヒストグラム
my_density <- function(data, mapping, ...) {
  ggplot(data = data, mapping = mapping) +
    geom_histogram(bins = 10, fill = "lightblue", color = "black", alpha = 0.7) +
    theme_minimal()
}


# --- 3. ggpairsを実行 ---

print("✅ 散布図相関行列 (Scatter Plot Matrix)")
ggpairs(
  df_for_plots,
  columnLabels = colnames(df_for_plots),
  # 左下: 相関係数のみ
  lower = list(continuous = my_cor_text), 
  # 右上: 散布図のみ
  upper = list(continuous = my_scatter_only), 
  # 対角線: ヒストグラム
  diag = list(continuous = my_density), 
  title = "主要5指標間の関係 (都道府県データ)"
)

# -----------------------------------------------------------
# 画像として保存するためのコード
# 1. ggpairsを実行 (前回の結果を 'scatter_matrix_plot' オブジェクトに保存)
# -----------------------------------------------------------

# ggpairsの結果を変数に格納します
scatter_matrix_plot <- ggpairs(
  df_for_plots,
  columnLabels = colnames(df_for_plots),
  lower = list(continuous = my_cor_text), 
  upper = list(continuous = my_scatter_only), 
  diag = list(continuous = my_density), 
  title = "主要5指標間の関係 (都道府県データ)"
)

print("✅ 散布図相関行列が生成されました。")


# -----------------------------------------------------------
# 2. プロットをPNGファイルとして保存
# -----------------------------------------------------------

# 保存するファイル名
file_name <- "scatter_matrix_plot.png"

# ggsave関数を使用してプロットを保存
# plot: 保存したいプロットオブジェクト (scatter_matrix_plot)
# filename: 保存するファイル名
# width, height: 画像のサイズをインチ単位で指定(行列図は通常、正方形で大きくすると見やすい)
# dpi: 解像度 (300は印刷やレポート用として標準的です)
ggsave(
  plot = scatter_matrix_plot, 
  filename = file_name,
  width = 10,  # 幅 10インチ
  height = 10, # 高さ 10インチ
  dpi = 300
)

cat(paste0("✅ プロットが「", file_name, "」として現在の作業ディレクトリに保存されました。\n"))

まとめ

 ここまでくると, 情報Ⅰの学習指導範囲を超える。そもそも作図がメインではない。
 
 最近他校を訪問し様々な授業を見学させてもらう中で, 自己調整型学習を実践している例をいくつか見た。今回の作図も生成AIを利用しながら取り組ませても面白い内容だと感じた。教師側がすべてを教えるのではなく, ポインタだけ示すことで生徒の主体的な活動を促すことができるのではと感じた題材だった。


いいなと思ったら応援しよう!

亀井 孝幸 応援よろしくお願いします。研究活動費として使わせていただきます。