NBAのデータ分析がしたい(データ準備編)
はじめに
この記事は、R advent calendar 2016 12/18 の担当分です。
ですが、Rとかクリスマスとか、どうでもいいのです。NBAを観ましょうNBA。
12月26日の朝4時30分から、キャバリアーズvsウォリアーズの試合があるのです。
最近はこの試合を楽しみに生きています。寂しくないです。
2015-2016年シーズンファイナルの激闘は、みなさんの記憶にも新しいはずです。
最終第7戦の最後まで目が離せない、最高の戦いでした。
今年はウォリアーズに、2013-2014シーズンMVPであるケビン・デュラントが加わりました。
ステファン・カリー、クレイ・トンプソン、ドレイモンド・グリーンとデュラントのオールスター選手4人が所属しており、
史上最強の呼び声も高いです。12月17日現在で23勝4敗、ウェスタンで1位です。
一方キャバリアーズは、昨年パッとしなかったケビン・ラブの調子が良く、
レブロン・ジェームズ、カイリー・アービングと共に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ポイントが決め、歴代記録が更新されました。
そこで、確認のために、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年分くらいが公開されています。
しかし、連続的に変化するバスケの試合を表現するようなデータは、ちゃんとお金を払わないと使えなさそう...
探してみたら、ありました。
なんと、試合中の各時刻における全選手の座標を取得することができます。
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前後の、レブロンジェームズのダンクまでの動きを、プロットしてみます。動画だと、このプレイです。
サイドからセンターにドリブルで移動、そこからドライブインしてダンク、という動きでした。
## データの抽出 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 の担当分でした。
明日は@siero5335さんの「森をさまよう」です。
...なんでしょう。怖い話でしょうか。楽しみですね。
以上です。