メジャーリーガーの出身地 (usmapの練習)
2026-08-09
アメリカの州別コロプレス図が面白いので, 色々と使ってみたいです.
今回は, メジャーリーガーの出身地分布を可視化します.
もともとはchoroplethrパッケージを使っていましたが,
choroplethrはCRANから 消えたため, usmapに載せ替えました.
州別人口もchoroplethrのdf_pop_stateを使っていましたが,
これも消えたので
usmapに同梱されているstatepop(2022年推計)を使います.
準備
library(data.table)
library(dplyr)
library(usmap)
library(ggplot2)使い方の確認
usmapの使い方を確認しておきます. マニュアル通りに, アメリカ各州の人口データを可視化してみます.
statepop %>% head## # A tibble: 6 × 4
## fips abbr full pop_2022
## <chr> <chr> <chr> <dbl>
## 1 01 AL Alabama 5074296
## 2 02 AK Alaska 733583
## 3 04 AZ Arizona 7359197
## 4 05 AR Arkansas 3045637
## 5 06 CA California 39029342
## 6 08 CO Colorado 5839926plot_usmap(data = statepop, values = "pop_2022") +
scale_fill_continuous(name = "population (2022)", label = scales::comma) +
theme(legend.position = "right")
state(州の略称かフルネーム)と値の列を持つデータフレームを用意して,
valuesに値の列名を渡せばいいみたいです.
メジャーリーガーの出身地データ
メジャーリーグのデータを用意します.
これは簡単で, Lahmanパッケージをインストールするだけです.
昔はMasterという名前のデータでしたが, Lahman
8.0でPeopleに改名されました.
## install.packages("Lahman")
library(Lahman)
## データのサイズ確認
People %>% dim## [1] 24270 26dat_master =
People %>% as.data.table %>%
select(nameFirst, nameLast, birthYear, birthCountry, birthState)
dat_master %>% head## nameFirst nameLast birthYear birthCountry birthState
## <char> <char> <int> <char> <char>
## 1: David Aardsma 1981 USA CO
## 2: Hank Aaron 1934 USA AL
## 3: Tommie Aaron 1939 USA AL
## 4: Don Aase 1954 USA CA
## 5: Andy Abad 1972 USA FL
## 6: Fernando Abad 1985 D.R. La Romana24,270人分の歴代メジャーリーガーについて, 名前, 誕生日, 出生地などのデータが格納されています.
他にも色々と面白そうなデータが入っていますが, 今回使うのは出生州です.
各州ごとにメジャーリーガーの数を集計してみます.
dat_player_state =
dat_master %>%
group_by(birthState) %>%
summarise(n = n()) %>%
arrange(desc(n))
dat_player_state %>% head## # A tibble: 6 × 2
## birthState n
## <chr> <int>
## 1 CA 2538
## 2 PA 1561
## 3 <NA> 1361
## 4 NY 1330
## 5 TX 1211
## 6 IL 1174CAってどの州の略称ですかね. よく分かりません.
birthStateはアメリカ以外の国の州・県も混ざっているので,
アメリカ50州だけに絞る必要があります.
datasets::stateのデータを使えば, 略称とフルネームとの対応付けが出来ます.
library(datasets)
## 州の名前と略称の対応表
dat_state = data.frame(name = state.name, abb = state.abb)
dat_state %>% head## name abb
## 1 Alabama AL
## 2 Alaska AK
## 3 Arizona AZ
## 4 Arkansas AR
## 5 California CA
## 6 Colorado CO## 出生地集計データとマージして, アメリカ50州だけ残す
dat_player_state_for_map =
dat_state %>%
mutate(birthState = abb) %>%
merge(dat_player_state, by = "birthState") %>%
mutate(state = abb, value = n) %>%
select(state, name, value)
## 上位5州
dat_player_state_for_map %>%
select(name, value) %>% arrange(desc(value)) %>%
head(5)## name value
## 1 California 2538
## 2 Pennsylvania 1561
## 3 New York 1330
## 4 Texas 1211
## 5 Illinois 1174plot_usmap(data = dat_player_state_for_map, values = "value") +
scale_fill_continuous(name = "MLB players", label = scales::comma) +
ggtitle("州別のメジャーリーガー輩出数") +
theme(legend.position = "right")
出身地別メジャーリーガーの人数の可視化が出来ました.
10万人あたりメジャーリーガーの数
人口に対する数で比べたいです. ただしここに落とし穴があります.
時代を揃える
上で数えたのは1871年以降の歴代全選手です. これを2022年の人口で割ると, 100年前に人口が多かった州が有利になります. 分子と分母の時代が合っていません.
実際, デビュー年で切ると顔ぶれが変わります.
by_era <-
People %>%
filter(birthCountry == "USA", !is.na(birthState), !is.na(debut)) %>%
mutate(デビュー年 = as.integer(substr(debut, 1, 4))) %>%
filter(birthState %in% state.abb)
bind_rows(
by_era %>% count(birthState) %>% arrange(desc(n)) %>% head(8) %>% mutate(範囲 = "全時代", 順位 = row_number()),
by_era %>% filter(デビュー年 >= 1980) %>% count(birthState) %>% arrange(desc(n)) %>% head(8) %>% mutate(範囲 = "1980年以降", 順位 = row_number())
) %>%
select(範囲, 順位, 州 = birthState, 人数 = n) %>%
tidyr::pivot_wider(names_from = 範囲, values_from = c(州, 人数)) %>%
knitr::kable()| 順位 | 州_全時代 | 州_1980年以降 | 人数_全時代 | 人数_1980年以降 |
|---|---|---|---|---|
| 1 | CA | CA | 2519 | 1564 |
| 2 | PA | TX | 1467 | 601 |
| 3 | NY | FL | 1262 | 579 |
| 4 | IL | IL | 1111 | 318 |
| 5 | OH | NY | 1068 | 312 |
| 6 | TX | GA | 1052 | 265 |
| 7 | MA | OH | 681 | 259 |
| 8 | FL | PA | 678 | 222 |
ペンシルベニアは全時代なら2位ですが, 1980年以降では8位まで下がります. 逆にテキサス, フロリダ, ジョージアが上がってきます. 人口の重心が北東部から南部へ移ったことを反映しています.
2022年の人口で割るなら, 分子も近年に揃えるべきです. 以下では1980年以降にデビューした選手を使います.
recent_players <-
by_era %>%
filter(デビュー年 >= 1980) %>%
count(birthState, name = "選手数") %>%
inner_join(data.frame(birthState = state.abb, name = state.name), by = "birthState") %>%
inner_join(statepop, by = c("birthState" = "abbr")) %>%
mutate(state = birthState,
value = 選手数 / pop_2022 * 100000)
best5 <- recent_players %>% arrange(desc(value)) %>% head(5)
worst5 <- recent_players %>% arrange(value) %>% head(5)
best5 %>% select(州 = name, 選手数, 人口 = pop_2022, `10万人あたり` = value) %>% knitr::kable(digits = 2)| 州 | 選手数 | 人口 | 10万人あたり |
|---|---|---|---|
| California | 1564 | 39029342 | 4.01 |
| Mississippi | 104 | 2940057 | 3.54 |
| Louisiana | 132 | 4590241 | 2.88 |
| Alabama | 140 | 5074296 | 2.76 |
| Oklahoma | 107 | 4019800 | 2.66 |
worst5 %>% select(州 = name, 選手数, 人口 = pop_2022, `10万人あたり` = value) %>% knitr::kable(digits = 2)| 州 | 選手数 | 人口 | 10万人あたり |
|---|---|---|---|
| Vermont | 4 | 647064 | 0.62 |
| Maine | 11 | 1385340 | 0.79 |
| Utah | 29 | 3380800 | 0.86 |
| Idaho | 17 | 1939033 | 0.88 |
| New Mexico | 20 | 2113344 | 0.95 |
plot_usmap(data = recent_players, values = "value") +
scale_fill_continuous(name = "MLB players / 100k") +
ggtitle("人口10万人あたりの輩出数 (1980年以降デビュー)") +
theme(legend.position = "right")
上位はCalifornia, Mississippi, Louisiana, 下位はVermont, Maine, Utahでした.
Californiaが突出していますが, 選手数1564人, 人口39.0百万人です. 人口の少ない州は分母が小さいぶん比が跳ねやすいので, 順位そのものは安定しません.
recent_players %>%
ggplot(aes(x = pop_2022 / 1e6, y = value)) +
geom_point() +
geom_text(aes(label = birthState), size = 3, vjust = -0.8, check_overlap = TRUE) +
scale_x_log10() +
xlab("人口 (百万人, 対数軸)") + ylab("10万人あたりの選手数") +
ggtitle("人口が少ない州ほど比が散らばる")
人口の少ない州が上にも下にも広がっています. これは実力差ではなく, 標本の小ささによるばらつきです.
まとめ
- 州別の輩出「数」はほぼ人口の大きさで決まる. カリフォルニアが1位なのは 人口が最多だから.
- 人口で割るときは分子と分母の時代を揃える. 歴代全選手を2022年人口で 割ると, 100年前に人口が多かった州が過大に出る.
- 揃えたうえでも, 人口の少ない州は比が跳ねやすい. 上位・下位の順位は そのまま「野球が盛んな州」の順位とは読めない.
残る注意
- 1980年以降にデビューした選手を, 2022年の人口で割っています. それでも45年ぶんの選手を1時点の人口で割っているので, 完全ではありません.
- 出生州は「生まれた場所」で, 育った場所とは限りません. 野球を覚えた土地を見たいなら本来は別のデータが要ります.
- 州の略称とフルネームの対応付けは
datasets::stateを使っています. アメリカ50州以外 (プエルトリコなど) は落ちます.