読者です 読者をやめる 読者になる 読者になる

300億円欲しい

メジャーリーグのデータ解析します

NBAのデータ分析がしたい(データ準備編)

はじめに

この記事は、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")

f:id:gg_hatano:20161218111111p:plain

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)")

f:id:gg_hatano:20161218111130p:plain

## 3ポイントの成功数
nbadata.threepoints %>% 
  ggplot(aes(x = Year, y = ThreesMade)) + 
  geom_line() + 
  geom_point() + 
  ggtitle("Three Point Shot (Made)")

f:id:gg_hatano:20161218111026p:plain

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")

f:id:gg_hatano:20161218110837p:plain

すごい!ちゃんとできています。

総移動距離

座標が取れているので、色々なことが分かりそうです。

例えば、各選手が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

...なんでしょう。怖い話でしょうか。楽しみですね。

以上です。