はじめに
この記事は、R advent calendar 2016 12/18 の担当分です。
qiita.com
ですが、Rとかクリスマスとか、どうでもいいのです。NBAを観ましょうNBA。
12月26日の朝4時30分から、キャバリアーズvsウォリアーズの試合があるのです。
watch.nba.com
最近はこの試合を楽しみに生きています。寂しくないです。
2015-2016年シーズンファイナルの激闘は、みなさんの記憶にも新しいはずです。
最終第7戦の最後まで目が離せない、最高の戦いでした。
www.nba.co.jp
今年はウォリアーズに、2013-2014シーズンMVPであるケビン・デュラントが加わりました。
ステファン・カリー、クレイ・トンプソン、ドレイモンド・グリーンとデュラントのオールスター選手4人が所属しており、
史上最強の呼び声も高いです。12月17日現在で23勝4敗、ウェスタンで1位です。
faknowledge.info
一方キャバリアーズは、昨年パッとしなかったケビン・ラブの調子が良く、
レブロン・ジェームズ、カイリー・アービングと共にBIG3で立ち向かうことができそうです。
12月17日現在で18勝6敗、イースタンで1位です。
興奮してきました。NBAのデータ分析しましょう。
NBAのシーズンデータ
まずはNBAについてどのようなデータが取得できるか、調べてみました。
シーズンの選手別成績は、SportsAnalyticsパッケージの関数を使って取得できます。
library(dplyr)
library(SportsAnalytics)
## データの取得
nbadata <- data.frame()
for (year in 0:15){
## シーズンを指定するための引数を作る
## 2015-2016シーズンだったら "15-16"
fetch.nbadata.arg <- paste(
sprintf("%02d", year),
sprintf("%02d", year+1),
sep="-"
)
## データの取得
nbadata.year <-
fetch_NBAPlayerStatistics(fetch.nbadata.arg)
## シーズンを表す列を作る
nbadata.year$Year <- 2000 + year
## 結合する
nbadata <-
rbind(nbadata, nbadata.year)
}
## 内容確認
> nbadata %>% names
[1] "League" "Name" "Team" "Position"
[5] "GamesPlayed" "TotalMinutesPlayed" "FieldGoalsMade" "FieldGoalsAttempted"
[9] "ThreesMade" "ThreesAttempted" "FreeThrowsMade" "FreeThrowsAttempted"
[13] "OffensiveRebounds" "TotalRebounds" "Assists" "Steals"
[17] "Turnovers" "Blocks" "PersonalFouls" "Disqualifications"
[21] "TotalPoints" "Technicals" "Ejections" "FlagrantFouls"
[25] "GamesStarted" "Year"
総得点の推移
シーズン別の総得点を集計してみます。
nbadata <- read.csv("nbadata_2015_2016.csv")
library(ggplot2)
## 総得点
nbadata.points <-
nbadata %>%
group_by(Year) %>%
summarise(Points = sum(TotalPoints))
## 総得点の可視化
nbadata.points %>%
ggplot(aes(x = Year, y = Points)) +
geom_line() +
geom_point() +
ggtitle("Total Points")
NBAは1シーズン82試合なのですが、2011-2012シーズンは66試合しか行われませんでした。
その影響で、シーズン総得点は2011年に落ち込んでいます。
しかし、全体として得点は増加傾向にあります。
オフェンスの効率が上がっているのか、ディフェンス力が低下しているのか。
今回は、オフェンスに注目してみます。
3ポイントシュートの成功率、成功数
昨今、色々なチームがウォリアーズの真似をしているのか、3ポイントシュートの数が増えている気がします。
最近も、ロケッツが1試合で24本の3ポイントが決め、歴代記録が更新されました。
www.nba.co.jp
そこで、確認のために、3ポイントシュートの成功率、成功数の推移を調べてみます。
## 3ポイントの集計
nbadata.threepoints <-
nbadata %>%
group_by(Year) %>%
summarise(ThreesAttempted = sum(ThreesAttempted),
ThreesMade = sum(ThreesMade))
## 3ポイントの成功率
nbadata.threepoints %>%
mutate(ThreesRate = ThreesMade / ThreesAttempted) %>%
ggplot(aes(x = Year, y = ThreesRate)) +
geom_line() +
geom_point() +
ggtitle("Three Point Shot (Rate)")
## 3ポイントの成功数
nbadata.threepoints %>%
ggplot(aes(x = Year, y = ThreesMade)) +
geom_line() +
geom_point() +
ggtitle("Three Point Shot (Made)")
3ポイントの成功数は、増加傾向にありそうです。
また、3ポイントの成功率は、2015-2016シーズンには増加しています。
闇雲に3ポイントを狙っているのではない、ということでしょう。3ポイントは得点力向上に寄与していそうです。
NBAのplay-by-play データ
次は、シーズンのデータではなく、もっと細かい、試合中のデータも扱いたいです 。
ただ、バスケでそれができるでしょうか。
状態変化が離散的であるスポーツは、データが作りやすそうです。
例えば、野球のデータは、80年分くらいが公開されています。
gg-hogehoge.hatenablog.com
しかし、連続的に変化するバスケの試合を表現するようなデータは、ちゃんとお金を払わないと使えなさそう...
探してみたら、ありました。
なんと、試合中の各時刻における全選手の座標を取得することができます。
library(RCurl)
library(jsonlite)
## NBA_SportVUをクローンします。
## system("git clone https://github.com/rajshah4/NBA_SportVu")
source("./NBA_SportVu/_functions.R")
ここを参考にしながら、
昨年の12/24の、キャバリアーズvsウォリアーズの試合データを取得してみました。
Rで扱いやすいように、dataframeにします。
## all.movements <- sportvu_convert_json("../data/0021500438.json")
1試合分で13列256万行。すごい。220MBありました。内容を見てみます。
all.movements <- read.csv("movements.csv")
all.movements %>% names
[1] "X" "player_id" "lastname" "firstname" "jersey" "position" "team_id"
[8] "x_loc" "y_loc" "radius" "game_clock" "shot_clock" "quarter" "event.id"
各時刻(0.04秒刻み?)で、コート上の全選手とボールの位置情報(x_loc, y_loc)がわかります。
...すごそう...
一旦、プレイを可視化してみます。
4Q3:30前後の、レブロンジェームズのダンクまでの動きを、プロットしてみます。動画だと、このプレイです。
stats.nba.com
サイドからセンターにドリブルで移動、そこからドライブインしてダンク、という動きでした。
## データの抽出
movements.493.lebron <-
all.movements %>%
filter(lastname == "James") %>%
filter(event.id == 493)
## 可視化(y座標は、ビデオの向きに合わせて調整する)
movements.493.lebron %>%
ggplot(aes(x = x_loc, y= 50-y_loc, group = lastname)) +
geom_path(aes(color = game_clock)) +
ylim(c(0,50)) +
ylab("y_loc")
すごい！ちゃんとできています。
総移動距離
座標が取れているので、色々なことが分かりそうです。
例えば、各選手が1試合でどれくらい移動したのか、見てみましょう。
## 総移動距離の計算
data.travelDist <-
all.movements %>%
group_by(firstname, lastname) %>%
summarise(totalDist = travelDist(x_loc, y_loc))
## kmに調整して、上位10人を出す
data.travelDist %>%
mutate(totalDist_km = totalDist * 30 / 100 / 1000) %>%
select(-totalDist) %>%
arrange(desc(totalDist_km)) %>%
head(10)
## 上位10人
lastname firstname[f:id:gg_hatano:20161218110837p:plain] totalDist_km
1 NA ball 8.711633
2 Kevin Love 4.896590
3 LeBron James 4.668445
4 Draymond Green 4.631822
5 Stephen Curry 4.534497
6 Klay Thompson 4.498305
7 Matthew Dellavedova 4.075169
8 Iman Shumpert 3.820774
9 Andre Iguodala 3.736349
10 Tristan Thompson 3.676420
...ボールにもセンサーがついていたのですね。
ボールの総移動距離は8.7km。ケビンラブは4.9kmも移動した、とのことでした。
おわりに
今年のお正月はNBAのデータで遊びましょう！
ところでこの記事は、R advent calendar 2016 12/18 の担当分でした。
qiita.com
明日は@siero5335さんの「森をさまよう」です。
qiita.com
...なんでしょう。怖い話でしょうか。楽しみですね。
以上です。
