R数据可视化简单小例子~NBA球员的薪资水平
R数据可视化简单小例子~NBA球员的薪资水平
在知乎看到问题：NBA最著名的高薪低能是谁?
想到了一个方法：获取球员的薪资水平和场均得分，然后按照场均得分除以薪资得到单位薪水场均得分，然后由小到大排序，越靠前说明性价比越差。当然单纯用得分来衡量一个球员的能力肯定是有失偏颇的，纯属娱乐，不必较真。
球员的薪资数据来自 http://www.espn.com/nba/salaries/_/year/2019，我选取的是2018-2019赛季的数据。
第一步：下载数据
简单的python脚本
import requests
from bs4 import BeautifulSoup
fw = open('NBA_salary.txt','w')
for i in range(1,14):
URL = "http://www.espn.com/nba/salaries/_/year/2019/page/" + str(i)
headers = {"User-Agent":'Mozilla/5.0 (Windows NT 10.0; WOW64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/81.0.4044.138 Safari/537.36'}
page = requests.get(URL,headers=headers)
soup = BeautifulSoup(page.content,'html.parser')
df = soup.find_all('tr')
for aa in df:
all_td = aa.find_all('td')
rk = all_td[0].get_text()
player = all_td[1].get_text()
team = all_td[2].get_text()
salary = all_td[3].get_text()
if rk == "RK":
continue
else:
fw.write('%s\t%s\t%s\t%s\n'%(rk,player,team,salary))
print(i)
fw.close()
对数据简单探索
2018-2019赛季薪水最高的五位球员是：
library(ggplot2)
library(stringr)
options(scipen = 200)
df2<-read.csv("NBA_salary.tsv",
header=F,sep="\t",
stringsAsFactors = F)
df3<-as.data.frame(matrix(unlist(str_split(df2$V2,',')),ncol=2,byrow=T))
head(df3)
df3$salary<-as.numeric(str_replace_all(df2$V4,',',''))
colnames(df3)<-c("Player",'Pos','Salary')
table(df3$Pos)
ggplot(df3[1:5,],aes(x=reorder(Player,Salary),y=Salary))+
geom_col(aes(fill=Player))+
geom_text(aes(label=Salary),hjust=1.2,color="white")+
coord_flip()+
theme_bw()+labs(x="")+
theme(legend.position = 'none')
image.png
薪水最高的5位球员分别是 库里、威少、詹姆斯、保罗和格里芬！其中威少，保罗和詹姆斯薪水是一样的。
接下来我们看一下不同位置的薪水是不是有差异。
df3$Salary<-df3$Salary/10000000
ggplot(df3,aes(x=Pos,y=Salary))+
geom_boxplot(aes(fill=Pos))+
theme_bw()+labs(y='薪水(千万/美刀)',x="")+
theme(legend.position = 'none')
image.png
从上图可以看出，平均薪资水平最高的是得分后卫。
我们将位置划分为中锋、前锋和后卫三个位置，看一下不同位置之间的差别
df4<-df3
df4$Pos<-ifelse(str_length(df4$Pos)==3,
str_sub(df4$Pos,3,3),
str_sub(df4$Pos,2,2))
head(df4)
table(df4$Pos)
help(package='ggpubr')
library(ggpubr)
color<-tidyquant::palette_dark()[1:3]
ggboxplot(df4,x="Pos",y="Salary",
color="Pos",bxp.errorbar =T,
palette = matrix(color)[,1],add="jitter")+
stat_compare_means(label.x.npc = "center")+
scale_x_discrete(labels=c('后卫','前锋','中锋'))+
labs(x="",y="薪水(千万/美刀)")
image.png
p值等于0.18，中锋、前锋和后卫的薪资均值没有显著差异。
接下来是球员薪水和场均得分的比值
球员的得分数据来自 https://www.basketball-reference.com/leagues/NBA_2019_totals.html
nba_points<-read.csv('2019_2019_points.csv',header=T,stringsAsFactors = F)
dim(nba_points)
nba_points[1:5,1:5]
colnames(nba_points)
library(dplyr)
df1<-nba_points%>%
group_by(Player)%>%
summarise(G = sum(G),
POS = Pos[1],
Age = mean(Age),
MP = sum(MP),
PTS = sum(PTS))
dim(df1)
head(df1)
head(df4)
df5<-df4%>%
left_join(df1,by = 'Player')
head(df5)
dim(df5)
df5$ptspergame<-df5$PTS/df5$G
head(df5)
df5$salaryperpts<-df5$ptspergame/df5$Salary
head(df5)
salaryperpts是单位薪水的得分值，这个数值越高，说明球员性价比越高。当然这个值对因为防守能力而拿到高薪的球员不是很友好。
首先看一下这个数值的整体分布
df6<-na.omit(df5)、
summary(df5$salaryperpts)
summary(df6$salaryperpts)
ggplot(data=df6,aes(x=salaryperpts)) +
geom_histogram(fill="#69b3a2",
color="#e9ecef", alpha=0.9)+
theme_bw()+
labs(x="",y="")+xlim(0,100)
image.png
从上图可以看出，绝大部分的人单位薪水得分在0~25之间，后面为什么有些数值偏大我暂时还不知道原因。
我们把薪水限制到2千万以上，数据从小到大排序，我们看看都是谁
df7<-df6[order(df6$salaryperpts),]
df8<-df7[df7$Salary>2,]
df8$Player<-factor(df8$Player,levels = df8$Player)
library(ggrepel)
pdf(file="1.pdf",width=15)
ggplot(df8,aes(x=Player,y=salaryperpts))+
geom_segment(aes(y=0,yend=salaryperpts,x=Player,xend=Player,
color=Player),size=0.5)+
geom_point(aes(color=Player),size=10)+
geom_label_repel(aes(label=Player))+
theme_void()+
theme(legend.position = 'none')
dev.off()
image.png
从上图从左到右前十名依次是：
- 1 莱恩安德森
- 2 帕森斯
- 3 海沃德
- 4 巴图姆
- 5 米尔萨普
- 6 保罗
- 7 洛瑞
- 8 霍福德
- 9 小乔丹
- 10 白边 怀特塞得
以上基本符合我们平时的认知，基本是高薪但是对球队贡献比较小的。但是洛瑞上榜挺出乎我的意料的。小乔丹和怀特塞德属于防守型，这个评价指标可能对他两不太公平。
让我选高薪低能我就选 帅哥帕森斯了。哈哈哈，前两名都是马赛克队出品。
上图从右往左前十名是：
- 1 哈登
- 2 欧文
- 3 莱昂纳德
- 4 字母哥
- 5 恩比德
- 6 浓眉哥
- 7 比尔
- 8 阿尔德里奇
- 9 利拉德
- 10 保罗乔治
都是鼎鼎大名，甚至都是MVP的有力竞争者。
这也从侧面反映单位薪水得分这个指标是有一定价值的。