【高等学校 Rを使ったデータ分析 no.6】「試作問題」の箱ひげ図
現在の学習指導要領では, 「箱ひげ図」は中学校第2学年の数学で「データの活用」に登場し, 高等学校数学I「データの分析」でも指導されている。
大学入学共通テストの試作問題をはじめ, これに基づいた副教材, 模試などにおいてもデータ分析の大問で「箱ひげ図」が登場している。しかし, 生徒が数学の授業の中で「箱ひげ図」を書くことがあったか, また探究活動を通して自ら必要と感じたことはあったか, と振り返った時に「なかった」というのが現実ではないか。
「情報I」の授業で実現可能かどうかは別問題として, 共通テスト試作問題の第4問で「花子さんたち」が行ったデータ分析を例に, 問題文中のデータや作図をR Studioを使って再現し, 授業へどのように落とし込むか考えてみた。
使用データ
平成28年社会基本調査調査票A に基づく結果のうち生活時間に関する結果から表番号59-1を使用したと思われる。
26ページに「一か所でも項目のデータに欠損値がある場合は, それらの都道府県を除外したものを全体と考える」とあるように, 確かに欠損値が存在した。
27ページ 問2
# 必要なライブラリを読み込む
library(ggplot2)
library(readxl)
library(tidyr)
# Excelファイルを読み込む
file_path <- "試作_第４問_a059_1.xlsx"
sheetA <- read_excel(file_path, sheet = "1時間未満")
sheetB <- read_excel(file_path, sheet = "3-6時間未満")
#######################################################
# 図1 必要な列（都道府県と睡眠）を抽出
sleep_data_A <- sheetA[, c("都道府県", "睡眠")]
sleep_data_B <- sheetB[, c("都道府県", "睡眠")]
# データフレームにラベルを追加
sleep_data_A$Sheet <- "1時間未満"
sleep_data_B$Sheet <- "3-6時間未満"
# データを結合
combined_data1 <- rbind(sleep_data_A, sleep_data_B)
# 箱ひげ図を作成
ggplot(combined_data1, aes(x = Sheet, y = 睡眠, fill = Sheet)) +
geom_boxplot() +
coord_flip() +
labs(title = "睡眠の比較 (SheetA vs SheetB)",
x = "データセット",
y = "睡眠時間 (分)") +
theme_minimal()
#######################################################
# 図2 必要な列（都道府県と学業）を抽出
study_data_C <- sheetA[, c("都道府県", "学業")]
study_data_D <- sheetB[, c("都道府県", "学業")]
# データフレームにラベルを追加
study_data_C$Sheet <- "1時間未満"
study_data_D$Sheet <- "3-6時間未"
# データを結合
combined_data2 <- rbind(study_data_C, study_data_D)
# 横向きの箱ひげ図を作成
ggplot(combined_data2, aes(x = Sheet, y = 学業, fill = Sheet)) +
geom_boxplot() +
coord_flip() +
labs(title = "学業の比較 (SheetC vs SheetD)",
x = "データセット",
y = "学習時間 (分)") +
theme_minimal()実は, 全てCopilotで作成したものである。コメントが分かりやすく, 手っ取り早く結果を見たい私のような用途では生成AIは使えます。
常々思うのですが, 「花子さんたち」のスッペックが高くないですか。以下, 問いに従ってCopilotにRスクリプトを作成してもらい実行を繰り返すことにした。
29ページ 問3
#######################################################
# 図3 必要な列（都道府県、睡眠時間、学業時間）を抽出
sleep_study_data_E <- sheetA[, c("都道府県", "睡眠", "学業")]
sleep_study_data_F <- sheetB[, c("都道府県", "睡眠", "学業")]
# 差分を計算
diff_data <- data.frame(
都道府県 = sleep_study_data_E$都道府県,
睡眠 = sleep_study_data_E$睡眠 - sleep_study_data_F$睡眠,
学業 = sleep_study_data_E$学業 - sleep_study_data_F$学業
)
# データフレームを長い形式に変換
diff_data_long <- gather(diff_data, key = "カテゴリ", value = "差分", -都道府県)
# 箱ひげ図を作成
ggplot(diff_data_long, aes(x = カテゴリ, y = 差分, fill = カテゴリ)) +
geom_boxplot() +
labs(title = "睡眠と学業の差分の比較",
x = "カテゴリ",
y = "差分（分）",
theme_minimal() 
31ページ 問4
#######################################################
# 図4 必要な列（睡眠時間と学業時間）を抽出
sleep_study_data <- sheetA[, c("睡眠", "学業")]
# 散布図を作成
scatter_plot <- ggplot(sleep_study_data, aes(x = 学業, y = 睡眠)) +
geom_point(color = "blue") +
labs(title = "睡眠時間と学業時間の散布図",
x = "学業時間 (分)",
y = "睡眠時間 (分)") +
theme_minimal()
# 散布図に箱ひげ図を追加
scatter_plot_with_marginal <- ggMarginal(scatter_plot, type = "boxplot", fill = "lightblue")
# プロットを表示
print(scatter_plot_with_marginal)
33ページ 図5
#######################################################
# 図5 必要な列（睡眠時間と学業時間）を抽出し、欠損値を除去
sleep_study_data <- sheetA[, c("睡眠", "学業")]
sleep_study_data <- na.omit(sleep_study_data)
# 回帰モデルを作成
model <- lm(睡眠 ~ 学業, data = sleep_study_data)
model_summary <- summary(model)
intercept <- round(model$coefficients[1], 2)
slope <- round(model$coefficients[2], 2)
equation <- paste("y = ", slope, "x + ", intercept)
# 散布図を作成し、回帰直線と方程式を追加
scatter_plot <- ggplot(sleep_study_data, aes(x = 学業, y = 睡眠)) +
geom_point(color = "blue") +
geom_smooth(method = "lm", color = "red", se = FALSE) +
annotate("text", x = max(sleep_study_data$学業) * 0.7, y = max(sleep_study_data$睡眠) * 0.9,
label = equation, color = "red", size = 5, hjust = 0) +
labs(title = "睡眠時間と学業時間の散布図",
x = "学業時間 (分)",
y = "睡眠時間 (分)") +
theme_minimal()
# プロットを表示
print(scatter_plot)
問題文の図と比較してみる
どんぴしゃり。探究活動の中で数学や情報と往還することで理解が深まりそうだ。（Copilotに作ってもらったとはいえ, 私はかなり深まりました）
あと問は一つだけだが, 使用したデータは睡眠と学業の時間だけで他の列は使用しなかったことになる。
34ページ 図6
#######################################################
# 図6 必要な列（睡眠時間と学業時間）を抽出し、欠損値を除去
sleep_study_data <- sheetA[, c("睡眠", "学業")]
sleep_study_data <- na.omit(sleep_study_data)
# 回帰モデルを作成
model <- lm(睡眠 ~ 学業, data = sleep_study_data)
# 推定される睡眠時間を計算
sleep_study_data$predicted_sleep <- predict(model, sleep_study_data)
# 残差を計算
sleep_study_data$residuals <- model$residuals
# 残差を標準化
sleep_study_data$standardized_residuals <- scale(sleep_study_data$residuals)
# 散布図を作成
scatter_plot <- ggplot(sleep_study_data, aes(x = predicted_sleep, y = standardized_residuals)) +
geom_point(color = "blue") +
labs(title = "推定睡眠時間と残差の変換値との関係",
x = "推定睡眠時間 (分)",
y = "残差の変換値") +
theme_minimal()
# プロットを表示
print(scatter_plot)
まとめ
60分の試験時間では得られない,深い理解ができた。「花子さんたち」のような探究活動をするようなきっかけ作りはどうしたら良いのだろうか。
今回の記事を授業に落とし込むのがこれからの課題となる。