はじめに
大学入学共通テスト「数学I」の問題を眺めていたところ,実際のデータを用いた出題となっていたことから,実際に学生に再現させてみると面白いかなーと思いまずは自分でやってみることにしました.
今年の問題はまだ大学入試センターの方では公開されていないようなので,朝日新聞デジタルへのリンクを貼っておきます.
総務省統計局の家計調査のデータを使いながら,ヒストグラム,箱ひげ図,散布図などを使いながら解答する内容になっています.
データをダウンロードする
まずはe-Statからデータを入手しましょう.お目当ての統計は家計調査の統計名「家計調査 家計収支編 二人以上の世帯」,表番号「010」,表題「品目分類(2020年改定)(総数:金額)」になります.トップからたどるときは,「家計調査」で検索し,「データベース」→「二人以上の世帯」→「年次」→「品目分類(2020年改定)(総数:金額)」→「DB」の順に進みます.
「表示項目選択」をクリックして必要な情報のみ残すようにします.
「品目分類」を選択するとすべての品目が選択されている状態になりますので,「全解除」をクリックしてから「364 うなぎのかば焼き」と「372 やきとり」のみ選択します.
「世帯区分」を選択し,「二人以上の世帯(2000年~)」のみ選択します.
「地域区分」を選択し「全国」のみ解除します.
「時間軸(年次)」を選択し,「全解除」してから「2020年」のみ選択します.
「表示項目選択」を離れ「レイアウト設定」を選び,各行に「地域区分」,各列に「品目分類」が表示されるように設定します.
「確定」を選ぶとデータの表示が更新されます.
CSVファイルとしてダウンロードする場合
このデータをCSVファイルとしてダウンロードする場合,右上の「↓ダウンロード」をクリックして「ファイル形式」として「CSV形式(クロス集計表形式・UTF-8(BOM無し))」を選択し,ページ下部の「ダウンロード」をクリックします.
ファイル名をuniv_entrance_exam_2023.csv
として保存したとして,これをデータフレームに読み込みます.その際にファイル先頭にヘッダがついていることから,スキップしてから読み込むことにします.
library(tidyverse)
univ_entrance_exam_2023 <- read_csv("univ_entrance_exam_2023.csv", skip = 11)
univ_entrance_exam_2023
# A tibble: 52 × 11
表章項目 コ…¹ 表章…² 世帯区…³ 世帯…⁴ 時間…⁵ 時間…⁶ 地域区…⁷ 地域…⁸ /品目…⁹
<chr> <chr> <chr> <chr> <dbl> <chr> <chr> <chr> <lgl>
1 01 金額 03 二人以… 2.02e9 2020年 01003 01100 … NA
2 01 金額 03 二人以… 2.02e9 2020年 02003 02201 … NA
3 01 金額 03 二人以… 2.02e9 2020年 03003 03201 … NA
4 01 金額 03 二人以… 2.02e9 2020年 04003 04100 … NA
5 01 金額 03 二人以… 2.02e9 2020年 05003 05201 … NA
6 01 金額 03 二人以… 2.02e9 2020年 06003 06201 … NA
7 01 金額 03 二人以… 2.02e9 2020年 07003 07201 … NA
8 01 金額 03 二人以… 2.02e9 2020年 08003 08201 … NA
9 01 金額 03 二人以… 2.02e9 2020年 09003 09201 … NA
10 01 金額 03 二人以… 2.02e9 2020年 10003 10201 … NA
# … with 42 more rows, 2 more variables: `364 うなぎのかば焼き【円】` <dbl>,
# `372 やきとり【円】` <dbl>, and abbreviated variable names
# ¹`表章項目 コード`, ²表章項目, ³`世帯区分(年次-二人以上の世帯) コード`,
# ⁴`世帯区分(年次-二人以上の世帯)`, ⁵`時間軸(年次) コード`,
# ⁶`時間軸(年次)`, ⁷`地域区分 コード`, ⁸地域区分,
# ⁹`/品目分類(2020年改定)`
地域区分
,かば焼き
,やきとり
の3列のみ残すことにします.
univ_entrance_exam_2023 <- univ_entrance_exam_2023 %>%
select(8, 10, 11) |>
rename("かば焼き" = 2, "やきとり" = 3)
univ_entrance_exam_2023
# A tibble: 52 × 3
地域区分 かば焼き やきとり
<chr> <dbl> <dbl>
1 01100 札幌市 2235 2779
2 02201 青森市 2055 4064
3 03201 盛岡市 2173 2572
4 04100 仙台市 2546 2280
5 05201 秋田市 1756 2109
6 06201 山形市 1733 2633
7 07201 福島市 2103 2102
8 08201 水戸市 2899 3206
9 09201 宇都宮市 2698 2370
10 10201 前橋市 2230 2365
# … with 42 more rows
APIを使ってダウンロードする場合
e-StatはAPI経由でデータを読み込むこともできます.APIを使うためにはあらかじめe-Statに登録し,アプリケーションIDを発行しておく必要があります.ここではアプリケーションIDはすでに発行済みであるとし,appId
オブジェクトに格納してあるとします.
appId <- 自分のアプリケーションID
先ほどのデータの抽出が終わった段階で,「↓ダウンロード」ではなく「API」をクリックします.「ファイル形式」として「CSV形式」を選択するとリクエストURLが表示されますので,「URLをコピー」をクリックしてURLをコピーしておきます.
このURLに対してhttr::GET()
でアクセスするのですが,&appId=
の後ろに自分のアプリケーションIDを挿入しないといけないのでpaste()
で連結してやります.
request_url <- paste("http://api.e-stat.go.jp/rest/3.0/app/getSimpleStatsData?cdArea=01003%2C02003%2C03003%2C04003%2C05003%2C06003%2C07003%2C08003%2C09003%2C10003%2C11003%2C12003%2C13003%2C14003%2C15003%2C16003%2C17003%2C18003%2C19003%2C20003%2C21003%2C22003%2C23003%2C24003%2C25003%2C26003%2C27003%2C28003%2C29003%2C30003%2C31003%2C32003%2C33003%2C34003%2C35003%2C36003%2C37003%2C38003%2C39003%2C40004%2C41003%2C42003%2C43003%2C44003%2C45003%2C46003%2C47003%2C14004%2C14150%2C22004%2C27004%2C40003&cdCat01=010920010%2C010920080&cdCat02=03&cdTime=2020000000&appId=",
appId,
"&lang=J&statsDataId=0003348239&metaGetFlg=Y&cntGetFlg=N&explanationGetFlg=Y&annotationGetFlg=Y§ionHeaderFlg=2&replaceSpChars=0",
sep = "")
httr::GET()
でアクセスします.
library(httr)
request <- GET(request_url)
あるいはパラメータをquery
に分割することにするならば次のようにも書くことができます.
response <- GET(url = "http://api.e-stat.go.jp/rest/3.0/app/getSimpleStatsData",
query = list(
appId = appId,
cdArea = "01003,02003,03003,04003,05003,06003,07003,08003,09003,10003,11003,12003,13003,14003,15003,16003,17003,18003,19003,20003,21003,22003,23003,24003,25003,26003,27003,28003,29003,30003,31003,32003,33003,34003,35003,36003,37003,38003,39003,40004,41003,42003,43003,44003,45003,46003,47003,14004,14150,22004,27004,40003",
cdCat01 = "010920010,010920080",
cdCat02 = "03",
cdTime = "2020000000",
lang = "J",
statsDataId = "0003348239",
metaGetFlg = "Y",
cntGetFlg = "N",
explanationGetFlg = "Y",
annotationGetFlg = "Y",
sectionHeaderFlg = "2",
replaceSpChars = "0"
)
)
response
からデータ本体をhttr::content()
で取り出します.
library(tidyverse)
res_content <- content(response)
univ_entrance_exam_2023 <- res_content |> read_csv()
univ_entrance_exam_2023
# A tibble: 104 × 13
tab_code 表章項目 cat01_code 品目分…¹ cat02…² 世帯…³ area_…⁴ 地域…⁵ time_…⁶
<chr> <chr> <chr> <chr> <chr> <chr> <chr> <chr> <dbl>
1 01 金額 010920010 364 う… 03 二人以… 01003 01100 … 2.02e9
2 01 金額 010920010 364 う… 03 二人以… 02003 02201 … 2.02e9
3 01 金額 010920010 364 う… 03 二人以… 03003 03201 … 2.02e9
4 01 金額 010920010 364 う… 03 二人以… 04003 04100 … 2.02e9
5 01 金額 010920010 364 う… 03 二人以… 05003 05201 … 2.02e9
6 01 金額 010920010 364 う… 03 二人以… 06003 06201 … 2.02e9
7 01 金額 010920010 364 う… 03 二人以… 07003 07201 … 2.02e9
8 01 金額 010920010 364 う… 03 二人以… 08003 08201 … 2.02e9
9 01 金額 010920010 364 う… 03 二人以… 09003 09201 … 2.02e9
10 01 金額 010920010 364 う… 03 二人以… 10003 10201 … 2.02e9
# … with 94 more rows, 4 more variables: `時間軸(年次)` <chr>, unit <chr>,
# value <dbl>, annotation <lgl>, and abbreviated variable names
# ¹`品目分類(2020年改定)`, ²cat02_code,
# ³`世帯区分(年次-二人以上の世帯)`, ⁴area_code, ⁵地域区分, ⁶time_code
データフレームを整形します.必要な列のみ残し,横長に変形します.
univ_entrance_exam_2023 <-
univ_entrance_exam_2023 |>
select(4, 8, 12) |>
pivot_wider(names_from = 1) |>
rename(かば焼き = 2, やきとり = 3)
univ_entrance_exam_2023
# A tibble: 52 × 3
地域区分 かば焼き やきとり
<chr> <dbl> <dbl>
1 01100 札幌市 2235 2779
2 02201 青森市 2055 4064
3 03201 盛岡市 2173 2572
4 04100 仙台市 2546 2280
5 05201 秋田市 1756 2109
6 06201 山形市 1733 2633
7 07201 福島市 2103 2102
8 08201 水戸市 2899 3206
9 09201 宇都宮市 2698 2370
10 10201 前橋市 2230 2365
# … with 42 more rows
ヒストグラムを作成する
geom_histogram()
を使ってヒストグラムを作成します.
- 区間幅は400円
- 線の色は黒
- 塗りつぶしは白
- 縦軸の目盛りは2ごと
- 横軸の目盛りは400ごと
- 縦軸見出しは「市の数」
- 横軸見出しは「円」
- タイトルは「かば焼きの支出金額のヒストグラム」
univ_entrance_exam_2023 %>%
ggplot(aes(x = かば焼き)) +
geom_histogram(binwidth = 400, color = "black", fill = "white", closed = "left") +
scale_x_continuous(breaks = seq(1000, 5000, by = 400)) +
scale_y_continuous(breaks = seq(0, 12, by = 2), limits = c(0, 12)) +
xlab("円") + ylab("市の数") + ggtitle("かば焼きの支出金額のヒストグラム")
箱ひげ図を作成する
次に地域Eと地域Wに分割して箱ひげ図を作成しますので,地域Eを表すオブジェクトeast
を作ってからデータフレームに組みこみます.
east <- c(rep(T, 15), F, F, F, T, T, rep(F, 27), T, T, F, F, F)
univ_entrance_exam_2023 <- univ_entrance_exam_2023 |>
mutate(地域E = east)
geom_boxplot()
を使って箱ひげ図を作成します.
- ひげをエラーバーにする
- 外れ値は考えない
- 地域Eのグラフを左側に
- 縦軸の目盛りは400円ごと
- グラフのタイトルは「かば焼きの支出金額」
univ_entrance_exam_2023 %>%
ggplot(aes(x = 地域E, y = かば焼き)) +
stat_boxplot(geom = "errorbar", width = 0.1, coef = Inf) +
geom_boxplot(coef = Inf) +
scale_x_discrete(limits = c(TRUE, FALSE),
labels = c(`TRUE` = "地域E", `FALSE` = "地域W")) +
scale_y_continuous(breaks = seq(1000, 5000, by = 400)) +
xlab("") + ylab("円") +
ggtitle("かば焼きの支出金額")
余談ですが,このひげの長さは浜松市がどちらに入るかで左右されているような…
散布図を作成する
地域Eのやきとりの支出金額と,かば焼きの支出金額の散布図を作成します.
univ_entrance_exam_2023 |>
filter(地域E) |>
ggplot(aes(x = やきとり, y = かば焼き)) +
geom_point() +
xlab("やきとりの支出金額") + ylab("かば焼きの支出金額") + ggtitle("地域Eにおける,やきとりとかば焼きの支出金額の散布図")