今回はNPBの観客動員数を見てみます。
今回もpython入門本の内容をRでやっていきます。
以下のページからデータがダウンロードできます。
まずはデータを見てみます。
library(tidyverse)
audience<-read.csv("C:/Users/ユーザー名/Downloads/2022_audience.csv")
glimpse(audience)
> glimpse(audience)
Rows: 858
Columns: 14
$ 年 <int> 2022, 2022, 2022, 2022, 2022, 2022, 2022, 2022, 2022, 2022, 20…
$ 月 <int> 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3,…
$ 日 <int> 25, 25, 25, 25, 25, 25, 26, 26, 26, 26, 26, 27, 27, 27, 27, 27…
$ 祝日 <lgl> FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE,…
$ 曜日 <chr> "金", "金", "金", "金", "金", "金", "土", "土", "土", "土", "…
$ Hチーム <chr> "ソ", "西", "楽", "D", "阪", "巨", "ソ", "西", "D", "阪", "巨"…
$ Vチーム <chr> "日", "オ", "ロ", "広", "ヤ", "中", "日", "オ", "広", "ヤ", "…
$ 球場 <chr> "PayPayドーム", "ベルーナドーム", "楽天生命パーク", "横浜スタ…
$ 本拠地 <lgl> TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TR…
$ 開始 <chr> "18:30", "18:00", "16:00", "18:30", "18:00", "18:15", "14:00",…
$ Hスコア <int> 4, 0, 0, 3, 8, 4, 6, 5, 5, 0, 7, 6, 7, 6, 6, 0, 5, 1, 1, 0, 3,…
$ Vスコア <int> 1, 6, 4, 11, 10, 2, 3, 0, 10, 6, 5, 4, 6, 5, 7, 4, 7, 2, 2, 4,…
$ 観客動員数 <int> 35141, 22646, 20564, 32436, 35510, 38156, 33380, 18109, 30663,…
$ 試合時間 <chr> "3:25", "2:48", "2:58", "3:31", "3:55", "3:19", "3:04", "2:37"…
データは2022年の日ごとの試合データです。
球場ごとの観客動員数を比較してみます。
ggplot(audience, aes(x = 球場 , y = 観客動員数)) +
geom_bar(stat = "identity") +
theme_bw()+
theme(axis.text.x = element_text(angle = 45, hjust = 1))
地方球場を省きます。
audience %>%
filter(本拠地=="TRUE") %>%
ggplot(aes(x = 球場 , y = 観客動員数)) +
geom_bar(stat = "identity") +
theme_bw()+
theme(axis.text.x = element_text(angle = 45, hjust = 1))+
labs(x="")
甲子園と東京ドームはさすがに多いですね。
曜日別に観客動員数を見てみます。
audience %>%
mutate(曜日順=factor(曜日, levels = c("月", "火", "水", "木", "金", "土","日"))) %>%
group_by(曜日順) %>%
summarise(平均観客動員数=mean(観客動員数)) %>%
ggplot(aes(x = 曜日順 , y = 平均観客動員数,group=1)) +
geom_line() +
geom_point()+
theme_bw()+
labs(x="")
土日と祝日の月曜に比べて火曜から木曜は2割くらい少ないですね。
対戦カードごとの観客動員数をヒートマップで見てみます。
12球団になるとおおいのでセリーグに絞ってみます。
audience_c<-audience %>%
filter(Hチーム %in% c("D", "ヤ", "巨", "広", "阪", "中")) %>%
filter(Vチーム %in% c("D", "ヤ", "巨", "広", "阪", "中")) %>%
group_by(Hチーム,Vチーム) %>%
summarise(平均観客動員数=mean(観客動員数))
audience_c
> audience_c
# A tibble: 30 × 3
# Groups: Hチーム [6]
Hチーム Vチーム 平均観客動員数
<chr> <chr> <dbl>
1 D ヤ 25735.
2 D 中 23020.
3 D 巨 23621.
4 D 広 27271.
5 D 阪 25523.
6 ヤ D 25434.
7 ヤ 中 19798.
8 ヤ 巨 24289.
9 ヤ 広 22858.
10 ヤ 阪 22170.
# ℹ 20 more rows
# ℹ Use `print(n = ...)` to see more rows
対戦カードごとの平均観客動員数が計算できました。
ヒートマップを作成します。
ggplot(audience_c, aes(x = Hチーム, y = Vチーム, fill = 平均観客動員数)) +
geom_tile() +
scale_fill_gradient(low = "white", high = "red") + # 色の指定
labs(x = "ホームチーム", y = "ビジターチーム", fill = "平均観客動員数") +
theme_minimal()
こうしてみると広島や中日もそこそこ人が入ってますね。
ヤクルトはリーグ優勝もして結構入っているかと思いきやそうでもないですね。
試合時間のデータもあるのでこれも同じように対戦カードごとに見てみます。
library(lubridate)
#時間が文字列になっているので時間データに変換
audience$試合時間<-hm(audience$試合時間)
#Periodオブジェクトを数値に変換
audience$試合時間 <- as.numeric(audience$試合時間, unit = "hours")
#対戦カードで集計
time<-audience %>%
filter(Hチーム %in% c("D", "ヤ", "巨", "広", "阪", "中")) %>%
filter(Vチーム %in% c("D", "ヤ", "巨", "広", "阪", "中")) %>%
group_by(Hチーム,Vチーム) %>%
summarise(平均試合時間=mean(試合時間))
# ヒートマップの作成
ggplot(time, aes(x = Hチーム, y = Vチーム, fill = 平均試合時間)) +
geom_tile() +
scale_fill_gradient(low = "white", high = "red") + # 色の指定
labs(x = "ホームチーム", y = "ビジターチーム", fill = "平均試合時間") +
theme_minimal()
マツダの阪神戦や横浜での広島戦、東京ドームや甲子園でのヤクルト戦が長くなってますね。
正確には地方球場なども入ってますがまあ細かいところはいいでしょう。
スコアのデータもあるのでこれも同じようにどの球場・対戦カードで得点が多いが見てみます。
audience<-audience %>%
mutate(合計得点=Hスコア+Vスコア)
score<-audience %>%
filter(Hチーム %in% c("D", "ヤ", "巨", "広", "阪", "中")) %>%
filter(Vチーム %in% c("D", "ヤ", "巨", "広", "阪", "中")) %>%
group_by(Hチーム,Vチーム) %>%
summarise(平均合計得点=mean(合計得点))
# ヒートマップの作成
ggplot(score, aes(x = Hチーム, y = Vチーム, fill = 平均合計得点)) +
geom_tile() +
scale_fill_gradient(low = "white", high = "red") + # 色の指定
labs(x = "ホームチーム", y = "ビジターチーム", fill = "平均合計得点") +
theme_minimal()
神宮の巨人戦がとんでもないことになってますね。
よくいわれているように横浜や神宮、東京ドームは点が入りやすい一方で、バンテリンや甲子園、マツダは入りにくくなってます。
得点と試合時間が関係ありそうなので試しにプロットしてみました。
install.packages("ggpmisc")
library(ggpmisc)
ggplot(audience,mapping = aes(x=得点合計,y=試合時間))+
geom_point()+
geom_smooth(method = "lm", formula = y ~ x)+
stat_poly_eq(formula = y ~ x,aes(label = paste(stat(eq.label),
stat(rr.label),
stat(p.value.label),
sep = "*\", \"*")),
label.x = "right",
label.y = "bottom",
parse = TRUE)+
theme_bw()
強くはないですが相関はありますね。なんだか今シーズンの得点の低さと試合時間の短さにも示唆を与える結果になってます。
観客動員数とホームチームの得点に関係があるか見てみました。
ggplot(audience,mapping = aes(x=観客動員数,y=Hスコア))+
geom_point()+
geom_smooth(method = "lm", formula = y ~ x)+
stat_poly_eq(formula = y ~ x,aes(label = paste(stat(eq.label),
stat(rr.label),
stat(p.value.label),
sep = "*\", \"*")),
label.x = "left",
label.y = "top",
parse = TRUE)+
theme_bw()
残念ながら？あんまり関係なさそうです。