NBAのデータ分析をしたいですね。とは言っても、野球やアメフトなどの離散型のデータではなくバスケは連続型のデータなので今回は簡単に、選手の身体サイズとシュート能力のデータの中に関係性が見られるのかという分析をしていきます。(逃げ)
便利なkaggleさんからデータをいただきました。
https://www.kaggle.com/drgilermo/nba-players-stats
シュート能力の指標としては単純にフリースローの成功数をとります。
player <- read.csv("nbaplayer.csv") str(player) 'data.frame': 3922 obs. of 8 variables: $ X : int 0 1 2 3 4 5 6 7 8 9 ... $ Player : Factor w/ 3922 levels "A.C. Green","A.J. Bramlett",..: 791 721 2418 1195 3044 1411 610 2834 1699 3772 ... $ height : int 180 188 193 196 178 180 196 183 196 196 ... $ weight : int 77 83 86 88 79 79 90 77 90 95 ... $ collage : Factor w/ 424 levels "","Acadia University",..: 128 314 344 192 314 159 313 263 182 301 ... $ born : int 1918 1921 1924 1925 1927 1926 1921 1924 1927 1927 ... $ birth_city : Factor w/ 1265 levels "","Abbeville",..: 1 1257 1 1 449 1 31 871 775 303 ... $ birth_state: Factor w/ 129 levels "","Alabama","Alaska",..: 1 48 1 1 57 1 46 92 80 48 …
まず始めに、3922人分の選手の名前と身長体重のデータを取得しました。
次は、これらの各選手のシュート能力の値としてフリースローの通算成功確率なんかを取って見たいと思います。
ss <- read.csv("Seasons_Stats.csv") str(ss) 'data.frame': 24691 obs. of 53 variables: $ X : int 0 1 2 3 4 5 6 7 8 9 ... $ Year : int 1950 1950 1950 1950 1950 1950 1950 1950 1950 1950 ... $ Player: Factor w/ 3922 levels "","A.C. Green",..: 792 722 2419 1196 1196 1196 3044 1412 611 611 ... $ Pos : Factor w/ 24 levels "","C","C-F","C-PF",..: 10 21 17 6 6 6 9 10 7 7 ... $ Age : int 31 29 25 24 24 24 22 23 28 28 ... $ Tm : Factor w/ 70 levels "","AND","ATL",..: 23 27 15 63 22 43 27 64 63 23 ... $ G : int 63 49 67 15 13 2 60 3 65 36 ... $ GS : int NA NA NA NA NA NA NA NA NA NA ... $ MP : int NA NA NA NA NA NA NA NA NA NA ... $ PER : num NA NA NA NA NA NA NA NA NA NA ... $ TS. : num 0.368 0.435 0.394 0.312 0.308 0.376 0.422 0.275 0.346 0.362 ... $ X3PAr : num NA NA NA NA NA NA NA NA NA NA ... $ FTr : num 0.467 0.387 0.259 0.395 0.378 0.75 0.301 0.313 0.395 0.48 ... $ ORB. : num NA NA NA NA NA NA NA NA NA NA ... $ DRB. : num NA NA NA NA NA NA NA NA NA NA ... $ TRB. : num NA NA NA NA NA NA NA NA NA NA ... $ AST. : num NA NA NA NA NA NA NA NA NA NA ... $ STL. : num NA NA NA NA NA NA NA NA NA NA ... $ BLK. : num NA NA NA NA NA NA NA NA NA NA ... $ TOV. : num NA NA NA NA NA NA NA NA NA NA ... $ USG. : num NA NA NA NA NA NA NA NA NA NA ... $ blanl : logi NA NA NA NA NA NA ... $ OWS : num -0.1 1.6 0.9 -0.5 -0.5 0 3.6 -0.1 -2.2 -0.7 ... $ DWS : num 3.6 0.6 2.8 -0.1 -0.1 0 1.2 0 5 2.2 ... $ WS : num 3.5 2.2 3.6 -0.6 -0.6 0 4.8 -0.1 2.8 1.5 ... $ WS.48 : num NA NA NA NA NA NA NA NA NA NA ... $ blank2: logi NA NA NA NA NA NA ... $ OBPM : num NA NA NA NA NA NA NA NA NA NA ... $ DBPM : num NA NA NA NA NA NA NA NA NA NA ... $ BPM : num NA NA NA NA NA NA NA NA NA NA ... $ VORP : num NA NA NA NA NA NA NA NA NA NA ... $ FG : int 144 102 174 22 21 1 340 5 226 125 ... $ FGA : int 516 274 499 86 82 4 936 16 813 435 ... $ FG. : num 0.279 0.372 0.349 0.256 0.256 0.25 0.363 0.313 0.278 0.287 ... $ X3P : int NA NA NA NA NA NA NA NA NA NA ... $ X3PA : int NA NA NA NA NA NA NA NA NA NA ... $ X3P. : num NA NA NA NA NA NA NA NA NA NA ... $ X2P : int 144 102 174 22 21 1 340 5 226 125 ... $ X2PA : int 516 274 499 86 82 4 936 16 813 435 ... $ X2P. : num 0.279 0.372 0.349 0.256 0.256 0.25 0.363 0.313 0.278 0.287 ... $ eFG. : num 0.279 0.372 0.349 0.256 0.256 0.25 0.363 0.313 0.278 0.287 ... $ FT : int 170 75 90 19 17 2 215 0 209 132 ... $ FTA : int 241 106 129 34 31 3 282 5 321 209 ... $ FT. : num 0.705 0.708 0.698 0.559 0.548 0.667 0.762 0 0.651 0.632 ... $ ORB : int NA NA NA NA NA NA NA NA NA NA ... $ DRB : int NA NA NA NA NA NA NA NA NA NA ... $ TRB : int NA NA NA NA NA NA NA NA NA NA ... $ AST : int 176 109 140 20 20 0 233 2 163 75 ... $ STL : int NA NA NA NA NA NA NA NA NA NA ... $ BLK : int NA NA NA NA NA NA NA NA NA NA ... $ TOV : int NA NA NA NA NA NA NA NA NA NA ... $ PF : int 217 99 192 29 27 2 132 6 273 140 ... $ PTS : int 458 279 438 63 59 4 895 10 661 382 …
こちらはさっきと違って結構膨大な量のデータになりますね。顕著なのは欠損値が多く見られることですが、NBAもリーグが発足した当初は今とルールがだいぶ違ったのは有名なことですので特に驚きはしませんね。3pointが無いバスケなんて今じゃ想像もできませんけどね…笑
ではこちらのデータを加工編集していきます。
names(ss) [1] "X" "Year" "Player" "Pos" "Age" "Tm" "G" "GS" "MP" [10] "PER" "TS." "X3PAr" "FTr" "ORB." "DRB." "TRB." "AST." "STL." [19] "BLK." "TOV." "USG." "blanl" "OWS" "DWS" "WS" "WS.48" "blank2" [28] "OBPM" "DBPM" "BPM" "VORP" "FG" "FGA" "FG." "X3P" "X3PA" [37] "X3P." "X2P" "X2PA" "X2P." "eFG." "FT" "FTA" "FT." "ORB" [46] "DRB" "TRB" "AST" "STL" "BLK" "TOV" "PF" "PTS" library(dplyr) sa <- select(ss, Year,Player,FT.) str(sa) 'data.frame': 24691 obs. of 3 variables: $ Year : int 1950 1950 1950 1950 1950 1950 1950 1950 1950 1950 ... $ Player: Factor w/ 3922 levels "","A.C. Green",..: 792 722 2419 1196 1196 1196 3044 1412 611 611 ... $ FT. : num 0.705 0.708 0.698 0.559 0.548 0.667 0.762 0 0.651 0.632 …
とりあえず見やすくするために、シーズンの年号、選手名とフリースロー成功率の列を抽出しました。
stats <- na.omit(sa) stats %>% dplyr::group_by(Player) %>% dplyr::summarise(FTP=mean(FT.)) # A tibble: 3,771 x 2 Player FTP1 A.C. Green 0.7080556 2 A.J. English 0.7740000 3 A.J. Guyton 0.8240000 4 A.J. Hammons 0.4500000 5 A.J. Price 0.6322500 6 A.J. Wynder 0.7500000 7 A.W. Holt 0.6670000 8 Aaron Brooks 0.8380000 9 Aaron Gordon 0.7026667 10 Aaron Gray 0.5600000 # ... with 3,761 more rows
スタッツにNAを含んでいる行を削除しました。
stats <- group_by(stats,Player) stats <- summarise(stats, FTP=mean(FT.)) head(stats) # A tibble: 6 x 2 Player FTP1 A.C. Green 0.7080556 2 A.J. English 0.7740000 3 A.J. Guyton 0.8240000 4 A.J. Hammons 0.4500000 5 A.J. Price 0.6322500 6 A.J. Wynder 0.7500000
これで二つのデータセットができましたね。
player <- select(player, Player,height,weight)
head(player)
Player height weight
1 Curly Armstrong 180 77
2 Cliff Barker 188 83
3 Leo Barnhorst 193 86
4 Ed Bartels 196 88
5 Ralph Beard 178 79
6 Gene Berce 180 79
これで、statsとplayerをマージさせます。
df <- merge(stats, player, by.x="Player", by.y="Player") str(df) 'data.frame': 3771 obs. of 4 variables: $ Player: Factor w/ 3922 levels "","A.C. Green",..: 2 4 5 6 7 8 9 10 11 12 ... $ FTP : num 0.708 0.774 0.824 0.45 0.632 ... $ height: int 203 196 208 198 213 190 206 183 206 213 ... $ weight: int 106 95 99 99 124 83 86 73 99 122 … df <- filter(df, FTP<0.9044, FTP>0)
試投数が少なすぎて通算成功率が0%だったりしている選手がいるみたいなのでこちらは今回は除外したいと思います。さらに調べたところ、歴代で通算最もキャリアでせいこうりつが高いのが90.43%のナッシュだということなのでそこを上限にしました。
では可視化をしていきましょう。とりあえず簡単な方からしていきましょう。
library(lattice)
cloud(FTP ~ weight * height, data = df, groups = Player)
実に気持ち悪いですね。笑
でもどうせ3Dならアニメーションで色んな角度から見て見たいものです。
library(rgl) plot3d(df$FTP, df$weight, df$height,size=1.3, col="red", lit=FALSE)
こちらが実際に様々な角度から見たものです。
P.S.
この前Coldplayのライブ行ってきました。前座がRadwimpsという贅沢な演出すぎて満足度高めでした。
個人的には
Everglow
とかのしみじみした曲とか
Charlie Brown
とかの明るいのも好きですね。
でもChainsmokerとのコラボで作った最近の
Something Just Like This(Alesso remix)
とかもEDMファンとしてはたまらないですね。(Alesso remixが個人的にはええと思う。)
