はじめに

大学入学共通テスト「数学I」の問題を眺めていたところ，実際のデータを用いた出題となっていたことから，実際に学生に再現させてみると面白いかなーと思いまずは自分でやってみることにしました．

今年の問題はまだ大学入試センターの方では公開されていないようなので，朝日新聞デジタルへのリンクを貼っておきます．

2023年度大学入学共通テスト数学Ⅰ 第3問

総務省統計局の家計調査のデータを使いながら，ヒストグラム，箱ひげ図，散布図などを使いながら解答する内容になっています．

データをダウンロードする

まずは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&sectionHeaderFlg=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における，やきとりとかば焼きの支出金額の散布図")