大數據分析作業- 從數據看 NBA 6號秀魔咒

01-29

　 NBA第六順位魔咒就是說在選秀歷史上，六號位的新秀最終成名的寥寥無幾，比七號位、八號位的新秀還少，就像是被詛咒一樣。

在過去20多年裡，6號順位誕生的球員有沃克、羅恩·莫塞爾、羅伯特·特雷勒、斯澤比亞克、德瑪爾·約翰遜、巴蒂爾、瓦格納、卡曼、柴德里斯、韋伯斯特、羅伊、加里納利、弗林、尤多、維塞利、利拉德、諾爾、斯瑪特以及斯坦恩等20多位球員，其中中國球員易建聯也在2007年以第六順位被密爾沃基雄鹿隊選中，並在隨後登陸NBA，雖然一開始就被寄以厚望，但也難逃6號秀魔咒，在2011年遺憾離開了NBA舞台，重新回國內聯賽效力。

這次趁著大數據學習的機會，想從數據方面角度觀察一下NBA 存在已久的6號秀魔咒。

首先，本文的數據下載自NBA Draft Value | Kaggle

數據包括兩方面：season78.csv:記錄自1979到2016賽季以來，所有球員的賽季勝利貢獻值，draft78.csv則記錄從1978年到2015年，所有參加選秀的球員的選秀順位，職業生涯時間。

提示：賽季開打時間是在選秀之後的年內11月份左右

導入相關包

library(dplyr)nlibrary(stringr)nlibrary(ggplot2)n

數據導入

#當前項目運行根路徑nprojectPath <- getwd()nndraft_path <- str_c(projectPath,n "db",n "draft78.csv",n sep = "/")nnseason_path <- str_c(projectPath,n "db",n "season78.csv",n sep = "/")nnn# 導入數據ndraft <- read.csv(draft_path, header = T, stringsAsFactors = F)nseason <- read.csv(season_path, header = T, stringsAsFactors = F)n# Merging Datanall <- merge(x = draft,y = season,by = "Player")nall$name <- paste(all$Player,all$Draft,sep = "-")n# 選擇職業生涯在4年以上的，選秀順位為4~10的新秀nSixth_draft<-filter(all,(Pick>3) & (Pick<11),Yrs>4)n

勝利貢獻值與新秀順位和職業生涯的關係

#勝利貢獻值與新秀順位關係分析ndis_Draft_vlue <- function(draft_data){n Draft_vlue <- draft_data %>% n group_by(Pick) %>%n select(Pick,WS) %>%n summarise(n MeanWS=mean(WS,na.rm=T)n )n return(Draft_vlue)n}nnn#勝利貢獻值與職業生涯長度關係分析ndis_player_carrer <- function(draft_data){nn Plear_career <- draft_data %>% n group_by(name) %>%n select(Yrs,WS) %>%n summarise(n Years=mean(Yrs,na.rm=T),n MeanWS=mean(WS,na.rm=T)n )n return(Plear_career)nn}n

6號秀與其他新秀的勝利貢獻值與職業生涯長度對比

每年選秀時，狀元，榜眼，探花人選基本上不會出現大的變動，或者有黑馬橫空出現，這些潛力股中潛力股是都是NCAA或其他國際的聯賽中的翹楚，實力是有目共睹的，反而4~10順位的隨機性會比較大，而更靠後的新秀往往實力比較不濟，出現遺珠是個小概率事件，所以分析時，只以4~10順位，且職業生涯滿足5年及以上的NBA球員作為樣本，這是考慮到NBA運動員的平均生涯是5年左右，且排除掉傷病等一些不可控因素。

dis_Sixth_draft <-function(draft_data){n Sixth_draft_value <- draft_data %>%n group_by(name) %>% n summarise(n Years=mean(Yrs,na.rm=T),n MeanWS=mean(WS,na.rm=T),n Draft_Pick=mean(Pick,na.rm=T)n ) %>%n mutate(career_data= Years*MeanWS) %>%n group_by(Draft_Pick) %>%n select(Draft_Pick,Years,career_data) %>%n summarise(n career_Years=mean(Years,na.rm=T),n career_value=mean(career_data,na.rm=T)n ) n return(Sixth_draft_value)n}n

圖形繪製

data <- dis_player_carrer(all)nview <-ggplot(data,aes(Years,MeanWS))+n geom_point(aes(size = MeanWS), alpha = .5,color = "blue") +n geom_smooth() +n xlab("Mean Win Share")+n ggtitle("Mean Win Share by Year")n#保存分析結果noutputpath <- str_c(projectPath,"output",n

可看出球員的職業生涯長度與球員對於比賽勝利的貢獻值是呈正相關的，老司機就是老司機，知道怎麼打球去贏得比賽。

data <- dis_Draft_vlue(all)nview <-ggplot(data,aes(x = Pick,y = MeanWS))+n geom_point(aes(size=MeanWS),alpha=.5)+n geom_smooth() +n scale_size_area()+n ylab("Mean Win Share")+n ggtitle("Win Share by Draft Pick")nn#保存分析結果noutputpath <- str_c(projectPath,"output","Draft_vlue.jpg",sep="/")nnggsave(filename=outputpath, plot=view)n

可看出選秀順位越靠前的球員總體表現越是出色，選秀遺珠還是小概率事件，是可遇不可求的。

data <- dis_Sixth_draft(Sixth_draft)nnview <-ggplot(data,aes(x = Draft_Pick,y = career_Years))+n geom_point(aes(size=career_Years),alpha=.5)+n geom_smooth() +n scale_size_area()+n ylab("Career value")+n ggtitle("Career valueby Draft Pick")nn#保存分析結果noutputpath <- str_c(projectPath,"output","Draft_career.jpg",sep="/")nnggsave(filename=outputpath, plot=view)nnview <-ggplot(data,aes(x = Draft_Pick,y = career_Years))+n geom_point(aes(size=career_value),alpha=.5)+n geom_smooth() +n scale_size_area()+n ylab("Career lenght")+n ggtitle("Career length by Draft Pick")nn#保存分析結果noutputpath <- str_c(projectPath,"output","Draft_carrer_length.jpg",sep="/")nnggsave(filename=outputpath, plot=view)n

可看出，6號秀無論是在職業生涯長度方面，還是對於比賽的貢獻方面，相比4，5順位的NBA球員有一段差距，就是跟7，8，9，10順位的運動員相比也是略遜一籌。

工程代碼分享

http://pan.baidu.com/s/1o8dXOKU