LoginSignup
4
2

More than 5 years have passed since last update.

@koki25ando

「Stephen Curryはどれだけ驚異的か？」NBAloveRパッケージを用いたNBAデータ分析

Last updated at Posted at 2019-01-05

ここ数年、王者に君臨するGolden State Warriorsを率いるスーパースターStephen Curryがどれほどすごいのかというのをたらたらと書くだけの記事です。
 
分析には先日から公開しているNBAloveRという名前のパッケージを用いましたので興味があればご覧下さい。

分析準備

# devtools::install_github("koki25ando/NBAloveR") 
library(NBAloveR)
library(tidyverse)

選手紹介 Stephen Curry

Players <- getPlayers()
Players %>% 
  filter(Player == "Stephen Curry" & Year == 2018)

     V1        Player Pos  HT  WT Age Teams GP YOS Pre-Draft Team      Draft Status   Nationality Year RookieYear
1 20862 Stephen Curry   G 6-3 190  29   GSW 51   8       Davidson 2009 Rnd 1 Pick 7 United States 2018       2010

デイビッドソン大学出身のStephen Curryは、データが示す通り、2010年のドラフト一巡目7位に指名された選手です。

getStatsSummary(Name="Stephen Curry")

  Season Age Tm  Lg Pos   G  GS   MP  FG  FGA   FG%  3P 3PA   3P%  2P 2PA   2P% eFG%  FT FTA   FT% ORB DRB TRB AST STL BLK TOV  PF  PTS
1 Career  NA    NBA     652 646 34.4 8.1 16.9 0.478 3.5 7.9 0.437 4.6   9 0.514 0.58 3.7 4.1 0.904 0.7 3.7 4.5 6.7 1.8 0.2 3.1 2.5 23.3

キャリアでは652試合をこなしていて、驚異的なのは何と言っても3ポイントに関する記録です。キャリア平均は、上記のデータ出力が提示するように、1試合3.5本、成功率は約43.7%です。

three_made_season<- getLeaders(stats_type="3PM", range="Single Season")
head(three_made_season, 10)

   Rank        Player X3P  Season
1    1. Stephen Curry 402 2015-16
2    2. Stephen Curry 324 2016-17
3    3. Stephen Curry 286 2014-15
4    4. Klay Thompson 276 2015-16
5    5. Stephen Curry 272 2012-13
6    6.    Ray Allen* 269 2005-06
7    7. Klay Thompson 268 2016-17
8    8.  Dennis Scott 267 1995-96
9    9.  James Harden 265 2017-18
10  10.  James Harden 262 2016-17

ちなみに、1シーズンでの3ポイント成功記録のTop10のうちBest1~3, 4位を独占するという恐ろしさです。笑

three_made_season$Rank <- three_made_season$Rank %>% 
  str_remove("\\.") %>% 
  as.numeric()
head(three_made_season, 10) %>% 
  ggplot(aes(Rank, X3P, fill = Player,
             label=X3P)) +
  geom_bar(stat = "identity") +
  geom_label(show.legend = F) +
  labs(y="Number of 3-point made", x="",
       title = "Top 10 3-point record in a single season")

3point.jpeg

1シーズンで402本は驚異的すぎですね笑

Dawkinsが総集編を出してますね。笑 Part4まであるので時間がある人は見てみてください。

キャリア全体での比較

ここまでは、1シーズンでのスタッツを比較してきたので、ここからは、キャリア全体では歴代で彼が現在どの位置にランクしているのか、さらには、最終的にはいつ現在歴代最高のシューターを追い越すことができるのかまで、みていきたいと思います。

three_made_career <- getLeaders(stats_type="3PM", range="Career")
head(three_made_career, 10)

   Rank         Player  X3P
1     1     Ray Allen* 2973
2     2 Reggie Miller* 2560
3     3    Jason Terry 2282
4     4    Kyle Korver 2271
5     5  Stephen Curry 2262
6     6 Jamal Crawford 2177
7     7   Vince Carter 2158
8     8    Paul Pierce 2143
9     9    Jason Kidd* 1988
10   10    Joe Johnson 1978

head(three_made_career, 10) %>% 
  ggplot(aes(reorder(Player, X3P), X3P, fill = Player,
             label=X3P)) +
  geom_bar(stat = "identity", show.legend = F) +
  geom_label(show.legend = F) +
  labs(y="Number of 3-point made", x="",
       title = "Top 10 Career 3-point Record") +
  coord_flip()

career3point.jpeg

上にはまだ、4選手いますね。歴代最高はキャリアで2973本決めている誰でも知っているレジェンド、Ray Allen。

Reggie Millerの記録を抜いたレイカーズ戦を覚えている人も結構多いのでは。NHKのBSで放送されたのを兄弟と観たのを今でも覚えています。懐かしい。

best_shooters <- head(three_made_career, 10)$Player %>% 
  str_remove("\\*")

best_shooters_summary <- Players %>% 
  filter(Player %in% best_shooters)
best_shooters_rec <- best_shooters_summary %>% 
  group_by(Player) %>% 
  mutate(max_year = max(Year)) %>% 
  filter(Year==max_year)
top10_3pointers <- best_shooters_rec[, c("Player", "Year", "RookieYear", "YOS")] %>% 
  arrange(desc(YOS))
top10_3pointers

# A tibble: 10 x 4
# Groups:   Player [10]
   Player          Year RookieYear   YOS
   <chr>          <int>      <int> <int>
 1 Vince Carter    2018       1999    19
 2 Jason Kidd      2013       1995    18
 3 Paul Pierce     2017       1999    18
 4 Jason Terry     2018       2000    18
 5 Reggie Miller   2005       1988    17
 6 Ray Allen       2014       1997    17
 7 Jamal Crawford  2018       2001    17
 8 Joe Johnson     2018       2002    16
 9 Kyle Korver     2018       2004    14
10 Stephen Curry   2018       2010     8

ここで現段階での歴代10人の名前、ルーキーシーズン、キャリアアクティブ年数などのデータを用意しました。ちなみに、ここからも分かりますがStephen Curryはキャリア年数が8年しかないにも関わらず、ランキング入りしていますね。

data_list = list()

for (i in 1:10){
  # paste(top10_3pointers$Player[i], top10_3pointers$RookieYear[i], top10_3pointers$YOS[i]) %>% 
  #   print()
  data_list[[i]] <- NBAloveR::getStatsPerGame(Player = top10_3pointers$Player[i], season = top10_3pointers$RookieYear[i], span=top10_3pointers$YOS[i])
  data_list[[i]]$Player = top10_3pointers$Player[i]
}

stats_per_game <- do.call(rbind, data_list)

p <- stats_per_game %>% 
  filter(GS != "Did Not Play" & GS != "Inactive" & GS != "Did Not Dress") %>% #ロスター入りしていないorプレイ時間が0の試合を除去
  group_by(Player) %>% 
  mutate(num = 1) %>% 
  mutate(GameNum = cumsum(num), career_3PM = cumsum(X3P)) %>% 
  ungroup() %>% 
  ggplot() +
  geom_line(aes(x=GameNum, y=career_3PM, group=Player, colour=Player,
                text = paste0(
                  "Name: ", Player,
                  "<br>3PM: ", career_3PM,
                  "<br>Games Played: ", GameNum
                ))) +
  labs(title = "Top 10 Best Career 3-Point Records", y = "Number of 3-Point Made") +
  theme_minimal()
plotly::ggplotly(p, tooltip="text")

とりあえず...一人だけ、規格外に傾きがおかしい模様です。
上記のプロットは次のリンクからもみることができます。
(http://rpubs.com/koki25ando/ThreePointRecords)

ちなみに、上記のプロットにはシーズン中であるため2018-19シーズンのデータは含まれていません。

いつ歴代一位になりそうか

では分析の締めくくりとして、いつ頃彼がRay Allenの記録である、2,973本を達成するのか見てみます。

sc30 <- stats_per_game %>% 
  filter(GS != "Did Not Play" & GS != "Inactive" & GS != "Did Not Dress" & Player == "Stephen Curry") %>% #ロスター入りしていないorプレイ時間が0の試合を除去
  group_by(Player) %>% 
  mutate(num = 1) %>% 
  mutate(GameNum = cumsum(num), career_3PM = cumsum(X3P)) %>% 
  ungroup()

diff <- 2973-max(sc30$career_3PM)
print(paste0(diff, "本決めれば歴代記録に並ぶ"))

[1] "844本決めれば歴代記録に並ぶ"

残り845本決めれば良いわけですね。
なので、なんとなくキリの良い、直近100試合の1試合あたりの平均3ポイント成功数を求めて、そこから具体的な日付を求める。という方向で求めます。

latest100_games_sc30 <- tail(sc30, 100) #直近100試合
avg_3pm <- mean(as.numeric(latest100_games_sc30$X3P))
print(paste0("直近100試合では1試合平均", avg_3pm, "本決めている"))

[1] "直近100試合では1試合平均4.23本決めている"

days_left = diff/avg_3pm+1
print(paste0(days_left, "試合後に新記録樹立！"))

[1] "200.52718試合後に新記録樹立！"

レギュラーシーズン82試合、さらにはプレーオフも含めると100試合くらいになったりして予想が難しいです。ただレギュラーシーズンでの欠場する場合なども考慮して、この際1シーズン82試合とカウントすることにします。
よって...

seasons_left <- days_left/82
print(paste0(seasons_left, "シーズン後に新記録達成予定"))

[1] "2.44545349708816シーズン後に新記録達成予定"

ということで、およそ、2.45シーズン後に彼は歴代最高記録を抜くだろう、という結果になりました。
このデータの最後が昨シーズンの終わりからなので、

2020-21シーズンのオールスターの前あたりという結果です。

superteam.jpg

利用した機能

  • getPlayers(): 歴代のNBAプレイヤーのデータセットを取得する。ポジションやサイズ、出身カレッジ、国籍など様々なデータを一覧できる。
  • getStatsSummary(Name): 任意のプレイヤーのキャリアスタッツサマリーデータの取得。
  • getLeaders(stats_type, range): 任意のスタッツのスタッツリーダーなどを取得できる。期間などを、1シーズンやキャリアなどに設定できる。
  • getStatsPerGame(Player, season, span): 任意のプレイヤーの試合毎のスタッツを所得できる。

結論

自分で作ったパッケージを使ってみて改めて、足りない部分などに気付けた。今までは足し算的に機能追加を行ってきたけが、少し方向修正が必要だと気付かされた。
NBA観戦は、自分のライフワークになっているので今後とも少しずつアップデートしていきます。NBA好きな人とかに使ってもらって意見などをいただきたいです。

以上。

4
2
0

Register as a new user and use Qiita more conveniently

  1. You get articles that match your needs
  2. You can efficiently read back useful information
  3. You can use dark theme
What you can do with signing up
Sign upLogin
4
2