我们将继续使用R分析篮球数据。
与以前的文章完全是娱乐性的不同，从分析球队本赛季战役的角度来看，本文中将要制作的图形可能会很有趣。
我们将针对三种类型的NBA球队评分建立移动平均线图：进攻，防守和净评分（即前两者之间的差异）。 简而言之。 进攻和防守等级是一组球队每100个回合得分/错过的得分数。 净等级-这是他们对一百个控球的区别。 有兴趣了解有关篮球的更多信息的人可以阅读篮球参考词汇表。 我也使用R实现了一个计算公式，但是我尚未发表有关该公式的文章。
我还将解释为什么要建立移动平均线图表。 在每个单独的比赛中，随机性的比例都很高，指标从70跃升至150，这使得数据分析无用，并且图表本身更像是心电图。 如果我们采用累计平均值，那么我们将得出另一个极端：进度类似于衰减的波动，并且在赛季结束时将比赛添加到已经举行的70-75场比赛中，实际上不会影响整体指标。 粗略地说，它们是“不可见的”。 在这种情况下，移动平均线是摆脱僵局的出路。 一方面，机会的影响减小，另一方面，结果没有过多的积累。 在篮球统计中，他们通常会进行10场比赛的移动平均。
使用的图书馆
library(httr) library(jsonlite) library(tidyverse) library(lubridate) library(zoo) library(ggthemes) library(gganimate)
使用NBA API检索数据
上次，我使用NBA Data Retriever扩展程序检索了数据。 这次我将使用NBA API将所需数据直接加载到R中。
首先，我们找出从何处获取此数据。 为此，请在stats.nba.com上打开我们需要的页面，然后转到开发人员工具。 然后打开网络-> XHR，然后按F5。 在出现的列表中，我们找到一个名称与页面名称相似的文件。 我们需要他。 确保选择了正确的文件后，将其地址复制到R中。在图片中看起来像这样。
打开所需的文件
该文件应如下所示
复制到R地址
现在，让我们开始在R Studio中工作。 为了获得我们需要的信息，我们使用http包的GET函数。 但是，为了正确执行请求（可以通过status_code函数检查，必须为200），您需要添加标头以确定HTTP事务的工作参数。
##Adding headers request_headers <- c( "accept-encoding" = "gzip, deflate, sdch", "accept-language" = "en-US,en;q=0.8", "cache-control" = "no-cache", "connection" = "keep-alive", "host" = "stats.nba.com", "pragma" = "no-cache", "upgrade-insecure-requests" = "1", "user-agent" = "Mozilla/5.0 (Macintosh; Intel Mac OS X 10_11_2) AppleWebKit/601.3.9 (KHTML, like Gecko) Version/9.0.2 Safari/601.3.9" ) #Getting a response request <- GET(adv_box_team, add_headers(request_headers))
我们得到这样的答案：
但是，尽管看不到我们需要的数据。 为了获得它们，我们首先将请求content通过函数content提取到json文件中，然后将其转换为带有jsonlite包中函数的列表，且其通话名称为fromJSON
boxscore_data <- fromJSON(content(request, as = "text"))
结果，我们得到一个已经包含我们所需所有信息的列表，然后我们将其简单地导入工作所需的表单中。
资料准备
为此，创建一个数据表而不是一个列表，然后添加列标题。
#Convert to tibble data and assigning column names table <- tbl_df(data.frame(boxscore_data$resultSets$rowSet[[1]], stringsAsFactors = FALSE)) names(table) <- toupper(boxscore_data$resultSets$headers[[1]])
toupper是使用大写字母替换所有字符的函数。 之后，我们应该得到一个包含2460行和46列的表。 原则上，您可以以这种形式使用表格，但是最好排除不必要的信息，以便更方便快捷地工作。
##Select the columns you want to analyze rating <- table %>% select(TEAM_ID, TEAM_ABBREVIATION, TEAM_NAME, GAME_ID, GAME_DATE, MATCHUP, WL, E_OFF_RATING, E_DEF_RATING, E_NET_RATING)
如果您查看源代码表，您会看到两种具有相同评级的类型：“正常”和前缀E。无需详细说明，E评级会考虑游戏的节奏，因此更加准确。 我们接受。
接下来，我要简化等级名称。 需要将它们引入函数参数中，最好使用更广泛的用户熟悉的符号：ORTG，DRTG，NRTG。 在这里，您可能会因编写正则表达式并替换为str_replace而感到“困惑”，但是编写它们仍然是一种享受，而在这里我们可以完美地做到这一点。 我们只需要提取当前名称的3、7、9和12个字符，将它们组合起来，然后将列名称替换为所得的字符向量即可。 所有这些都是使用stringr软件包的功能完成的： str_sub和str_c （基本paste0的类似物）。
## Renaming columns with E_OFF_RATING on ORTG rating1 <- rating %>% rename_at(vars(starts_with("E_")), list(~str_c(str_sub(., start = 3, end = 3), str_sub(., start = 7, end = 7), str_sub(., start = 9, end = 9), str_sub(., start = 12, end = 12))))
包函数中的dplyr与dplyr包中的dt[, lapply(.SD, func), .SDols = col1]具有相同的属性：该操作同时应用于多个列。 在这里，我们选择名称以“ E_”开头的所有列。
结果，我们得到了这样一个表，我们将继续使用该表：
rolling_offnet_rating_nba函数用于绘制移动平均值并为其设置动画。
再次，像上次一样，让我们创建一个函数以在计算中进行最小的更改。
rolling_offnet_rating_nba函数如下所示：
rolling_offnet_rating_nba <- function(table, name, variable, col1 = col1, col2 = col2)
table是数据表的名称，
名称 -将为其制作图形的团队的缩写（“ BOS”，“ LAL”等）。
变量 -将要计算的等级（这里有两个选项，ORTG或NRTG，为保护等级我做了一个单独的功能）
col1和col2-高于/低于平均值的线条颜色。
大多数dplyr函数使用非标准评估（NSE ）。 这是一个通用术语，意味着它们的评估不同于R中的常规评估。这使我们能够简化代码编写和使用SQL数据库的工作，但是要减去的是，我们无法用在其他地方定义的等效对象替换该值。
Dplyr使用Tidy评估 。 因此，有必要使用特殊工具（引用功能，运算符!!）来解决编程期间遇到的问题。 您可以在这里阅读更多有关此内容的信息 ，并在此处查看 。
以下代码采用了函数参数的名称，并编写了呈现给它的表达式。 （要了解enquo及其类似函数的工作方式，打印此函数的输出很有用）
##Return the entered value in the function argument in the type quosure quo_rating <- enquo(variable) quo_col1 <- enquo(col1) quo_col2 <- enquo(col2)
接下来，我们更改某些列的数据格式：我们将字符的GAME_DATE设置为Date格式的列，并将评分列设置为数字。 因为 我们将as.numeric函数应用于三列，然后使用mutate_at代替mutate 。 然后，我们按照日期的升序对所有内容进行排序。
##Changing the data type of multiple columns test1 <- table %>% mutate(GAME_DATE = as.Date(ymd_hms(GAME_DATE))) %>% mutate_at(vars(ORTG:NRTG), list(~as.numeric)) %>% arrange(GAME_DATE)
然后，我们计算所需球队的10场比赛移动平均值。 为此，请使用zoo包中的rollmeanr函数。 名称末尾的r表示结果应右对齐。 对于本赛季的前九场比赛，移动10场均值是完全不可能计算的，因此我们通过使用fill参数将其填充为NA来使这些字段保持不变。 na.omit从表中删除出现这些NA的行。
##The calculation of the moving average team <- test1 %>% filter(TEAM_ABBREVIATION == "DAL") %>% mutate(RATING = rollmeanr(ORTG, k = 10, fill= NA)) %>% na.omit(test1)
团队表如下所示：
原则上，我们已经收到了所需的信息。 使用两行代码，您可以构建一个折线图。 但是从美学和信息角度来看，白色背景上的黑线都没什么意义。 “功能主体”的另一部分对此进行了纠正。
首先，我们将数据添加到平均值，第10位和第21位（从底部算起的第十位）以及团队比赛的日期10（即第一个要计算移动平均值并在删除NA中的行之后保留在团队表中的日期）的数据。 。
##The average, 10 and 21 ratings in the entire League. average <- league %>% mutate(average = mean(!! quo_rating)) %>% select(average) %>% unique() %>% .$average top10 <- league %>% arrange(desc(!! quo_rating)) %>% select(!! quo_rating) %>% slice(10) top10 <- top10[[1]] bottom10 <- league %>% arrange(desc(!! quo_rating)) %>% select(!! quo_rating) %>% slice(21) bottom10 <- bottom10[[1]] ##Getting the date of the first rollaverage data <- team %>% select(GAME_DATE) %>% arrange(GAME_DATE) data <- data[[1,1]]
从以前未使用的功能中，出现slice功能，该功能通过序列号选择行。
接下来，我们选择2种颜色及其名称。 上次数据table_color表。 该名称将在图表的标题中使用，以说明哪种颜色对应的值低于平均值，而哪个更高。
##Getting color and color_name selected color color1 <- table_color %>% filter(TEAM_ABBREVIATION == name) %>% select(!! quo_col1) color1 <- color1[[1]] color2 <- table_color %>% filter(TEAM_ABBREVIATION == name) %>% select(!! quo_col2) color2 <- color2[[1]] name1 <- paste0("name_", quo_name(quo_col1)) name2 <- paste0("name_", quo_name(quo_col2)) name_color1 <- table_color %>% filter(TEAM_ABBREVIATION == name) %>% select(name1) name_color1 <- name_color1[[1]] name_color2 <- table_color %>% filter(TEAM_ABBREVIATION == name) %>% select(name2) name_color2 <- name_color2[[1]]
函数参数默认为col1和col2，它们是命令的第一和第二颜色。 在大多数情况下（更确切地说，在26中），无需更改这些值，但是，对于四个团队，应在其调色板中使用以下颜色。 在达拉斯和明尼苏达州，第一种和第二种颜色太相似，而在密尔沃基和布鲁克林，它们在白色背景上不可见。 两者和另一个使时间表的读取变得复杂，因此值得为它们使用参数col2 = col3。
接下来，我们将获得团队的最高评分。 我们将需要此值来将文本与评级值排列在图表上。 我要注意最后一行代码。 碰巧这些功能在90个案例中有89个完美绘制了图表，但是在建立保护等级时，密尔沃基给出了一个错误。 事实证明，密尔沃基的最大额定值达到了两倍，并且ggplot2自然开始发誓，在我们的情况下，美学应该为1或73。因此，我们需要一个最大额定值。
##The maximum value of the rating max <- team %>% filter(RATING == max(RATING)) %>% select(RATING) max <- max[[1]]
在ggplot2构建静态图
##Building and save a static chart Sys.setlocale("LC_ALL", "C") gg <- ggplot(team, aes(GAME_DATE, RATING)) + geom_hline(yintercept = c(top10, bottom10), col = c("red", "blue")) + annotate(geom = "text", x = as.Date(data) + 2, y = top10 - 0.2, label = "TOP 10", col = "red") + annotate(geom = "text", x = as.Date(data) + 2, y = bottom10 + 0.2, label = "BOTTOM 10", col = "blue") + geom_line(size = 2, col = if_else(team$RATING > average, color1, color2)) + theme_tufte() + labs(title = paste0(team$TEAM_NAME, " 10-Game Rolling ", quo_name(quo_rating)), subtitle = paste0(paste0(name_color1, " - above average ", quo_name(quo_rating)), "\n", paste0(name_color2, " - below average ", quo_name(quo_rating))), caption = "Source: BBall Index Data & Tools\nTelegram: @NBAatlantic, twitter: @vshufinskiy") theme(plot.title = element_text(size = 12, hjust = 0.5), plot.caption = element_text(size = 10), plot.subtitle = element_text(size = 9)) ggsave(paste0(unique(team$TEAM_NAME), quo_name(quo_rating), ".jpeg"), gg, width = 8, units = "in")
在这里的新功能中，使用if_else函数根据联赛的平均评分是较高还是较低以及更改语言环境的第一行来更改行的颜色。 这样做是为了使X轴上月份名称的缩写用英语书写。
10场均线的动画。
在动画的构造中，我添加了一些静态版本无法使用的乳液。 首先，更改日期（类似于上一篇文章中的年份更改方式）以及特定时间点的评级值。 它也会根据颜色是高于还是低于平均值来改变颜色。
##Building animations anim <- gg + theme(plot.title = element_text(hjust = 0.5, size = 25), plot.subtitle = element_text(size = 15), plot.caption = element_text(size = 15), axis.text = element_text(size = 15), axis.title = element_text(size = 18)) + geom_text(aes(x = as.Date(data), y = max + 0.5), label = paste0(quo_name(quo_rating)," ", round(team$RATING, digits = 1)), size = 6, col = if_else(team$RATING > average, color1, color2)) + transition_reveal(GAME_DATE) + labs(title = paste0(team$TEAM_NAME, " 10-Game Rolling ", quo_name(quo_rating)), subtitle = paste0(paste0(name_color1, " - above average ",quo_name(quo_rating)), "\n", paste0(name_color2, " - below average ",quo_name(quo_rating)), "\n", "Date: {frame_along}"), caption = paste0("Source: stats.nba.com\nTelegram: @NBAatlantic, twitter: @vshufinskiy"))
结果
从图表上可以明显看出，达拉斯在2月至3月下半月有所下降。 对此的解释很简单：正是在本赛季的这一点上，小牛队交换了他们前五名球员中五名球员中的四名，而主要的传入资产拉脱维亚·克里斯塔普斯·波津吉斯由于十字韧带的断裂而没有打一分钟。
在这里我不会深入研究体育部分，因此如果有人有兴趣查看2018-19赛季剩余的89张图表，那么欢迎您访问我在sports.ru上的博客 ，我计划在其中写一篇文章，概述其中最有趣的内容或在Telegram中有关NBA的频道 ，我将在其中发布所有内容。
GitHub存储库