Извините за мой английский.
Я создаю функцию для отображения скользящей средней сезона NBA.Я делаю анимацию, часть которой отображает текущий рейтинг.Я делаю это с geom_text.Проблема в том, что вместо отображения одного значения вы получаете беспорядок.
Код:
library(httr)
library(jsonlite)
library(tidyverse)
##Getting data via NBA API.
##Required link
adv_box_team <- "https://stats.nba.com/stats/teamgamelogs?DateFrom=&DateTo=&GameSegment=&LastNGames=0&LeagueID=00&Location=&MeasureType=Advanced&Month=0&OpponentTeamID=0&Outcome=&PORound=0&PaceAdjust=N&PerMode=Totals&Period=0&PlusMinus=N&Rank=N&Season=2018-19&SeasonSegment=&SeasonType=Regular+Season&ShotClockRange=&VsConference=&VsDivision="
##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))
#Convert to js.file to list
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]])
library(tidyverse)
library(lubridate)
library(zoo)
library(ggthemes)
library(gganimate)
library(rlang)
library(data.table)
##Cleaning data
rating <- table %>%
select(TEAM_ID,
TEAM_ABBREVIATION,
TEAM_NAME,
GAME_ID,
GAME_DATE,
MATCHUP,
WL,
E_OFF_RATING,
E_DEF_RATING,
E_NET_RATING)
rating1 <- rating %>%
rename_at(vars(starts_with("E_")),
funs(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))))
rolling_offnet_rating_nba <- function(table, variable, name, col1 = col1, col2 = col2){
quo_rating <- enquo(variable)
quo_col1 <- enquo(col1)
quo_col2 <- enquo(col2)
test1 <- rating1 %>%
mutate(GAME_DATE = as.Date(ymd_hms(GAME_DATE))) %>%
mutate_at(vars(ORTG:NRTG), list(~as.numeric))
team <- test1 %>%
filter(TEAM_ABBREVIATION == name) %>%
mutate(RATING = rollmeanr(!! quo_rating, k = 10, fill= NA)) %>%
na.omit(test1)
league <- test1 %>%
group_by(TEAM_NAME) %>%
summarise(ORTG = mean(ORTG),
DRTG = mean(DRTG),
NTRG = mean(NRTG))
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]]
data <- team %>%
select(GAME_DATE) %>%
unique() %>%
arrange(GAME_DATE)
data <- data[[1,1]]
table_color <- data.table(TEAM_ID = c(1610612737, 1610612738, 1610612751, 1610612766, 1610612741, 1610612739, 1610612742,
1610612743, 1610612765, 1610612744, 1610612745, 1610612754, 1610612746, 1610612747,
1610612763, 1610612748, 1610612749, 1610612750, 1610612740, 1610612752, 1610612760,
1610612753, 1610612755, 1610612756, 1610612757, 1610612758, 1610612759, 1610612761,
1610612762, 1610612764),
TEAM_NAME = c("Atlanta Hawks", "Boston Celtics", "Brooklyn Nets",
"Charlotte Hornets", "Chicago Bulls", "Cleveland Cavaliers",
"Dallas Mavericks", "Denver Nuggets", "Detroit Pistons",
"Golden State Warriors", "Houston Rockets", "Indiana Pacers",
"LA Clippers", "Los Angeles Lakers", "Memphis Grizzlies",
"Miami Heat", "Milwaukee Bucks", "Minnesota Timberwolves",
"New Orleans Pelicans", "New York Knicks", "Oklahoma City Thunder",
"Orlando Magic", "Philadelphia 76ers", "Phoenix Suns",
"Portland Trail Blazers", "Sacramento Kings", "San Antonio Spurs",
"Toronto Raptors", "Utah Jazz", "Washington Wizards"),
TEAM_ABBREVIATION = c("ATL", "BOS", "BKN", "CHA", "CHI", "CLE", "DAL", "DEN", "DET", "GSW", "HOU", "IND", "LAC", "LAL",
"MEM", "MIA", "MIL", "MIN", "NOP", "NYK", "OKC", "ORL", "PHI", "PHX", "POR", "SAC", "SAS", "TOR",
"UTA", "WAS"),
col1 = c("#E03A3E", "#007A33", "#000000", "#1D1160", "#CE1141", "#6F263D", "#00538C", "#0E2240",
"#C8102E", "#006BB6", "#CE1141", "#002D62", "#C8102E", "#552583", "#5D76A9", "#98002E",
"#00471B", "#0C2340", "#0C2340", "#006BB6", "#007AC1", "#0077C0", "#006BB6", "#1D1160",
"#E03A3E", "#5A2D81", "#C4CED4", "#CE1141", "#002B5C", "#002B5C"),
name_col1 = c("HAWKS RED", "CELTICS GREEN", "BLACK",
"HORNETS PURPLE", "BULLS RED", "CAVALIERS WINE",
"ROYAL BLUE", "MIDNIGHT BLUE", "RED",
"WARRIORS ROYAL BLUE", "RED", "PACERS BLUE",
"RED", "LAKERS PURPLE", "BLUE",
"RED", "GOOD LAND GREEN", "MIDNIGHT BLUE",
"PELICANS NAVY", "KNICKS BLUE", "THUNDER BLUE",
"MAGIC BLUE", "BLUE", "PURPLE",
"RED", "PURPLE", "SILVER",
"RED", "NAVY", "NAVY BLUE"),
col2 = c("#C1D32F", "#BA9653", "#FFFFFF", "#00788C", "#000000", "#041E42", "#002B5E", "#FEC524",
"#006BB6", "#FDB927", "#000000", "#FDBB30", "#1D428A", "#FDB927", "#12173F", "#F9A01B",
"#EEE1C6", "#236192", "#C8102E", "#F58426", "#EF3B24", "#C4CED4", "#ED174C", "#E56020",
"#000000", "#63727A", "#000000", "#000000", "#00471B", "#E31837"),
name_col2 = c("VOLT GREEN", "CELTICS GOLD", "WHITE", "TEAL",
"BLACK", "CAVALIERS NAVY", "NAVY BLUE", "SUNSHINE YELLOW",
"ROYAL", "GOLDEN YELLOW", "BLACK", "YELLOW",
"BLUE", "GOLD", "NAVY", "YELLOW",
"CREAM CITY CREAM", "LAKE BLUE", "PELICANS RED", "KNICKS ORANGE",
"SUNSET", "SILVER", "RED", "ORANGE",
"BLACK", "GRAY", "BLACK", "BLACK",
"GREEN", "RED"),
col3 = c("#26282A", "#963821", NA, "#A1A1A4", NA, "#FFB81C", "#B8C4CA", "#8B2131",
"#BEC0C2", "#26282A", "#C4CED4", "#BEC0C2", "#BEC0C2", "#000000", "#F5B112", "#000000",
"#0077C0", "#9EA2A2", "#85714D", "#BEC0C2", "#002D62", "#000000", "#002B5C", "#000000",
NA, "#000000", NA, "#A1A1A4", "#F9A01B", "#C4CED4"),
name_col3 = c("HAWKS CHARCOAL", "CELTICS BROWN", NA, "GRAY",
NA, "CAVALIERS NAVY", "SILVER", "FLATIRONS RED",
"GRAY", "SLATE", "SILVER", "SILVER",
"SILVER", "BLACK", "YELLOW", "BLACK",
"GREAT LAKES BLUE", "MOONLIGHT GREY", "PELICANS GOLD", "KNICKS SILVER",
"BLUE", "BLACK", "NAVY", "BLACK",
NA, "BLACK", NA, "SILVER",
"YELLOW", "SILVER" ),
col4 = c( NA, "#E59E6D", NA, NA, NA, "#000000", "#000000", "#1D428A",
"#002D62", NA, NA, NA, "#000000", NA, "#707271", NA,
"#000000", "#78BE20", NA, "#000000", "#FDBB30", NA, "#C4CED4", "#63727A",
NA, NA, NA, "#B4975A", NA, NA ),
name_col4 = c( NA, "CELTICS BEIGE", NA, NA,
NA, "CAVALIERS BLACK", "BLACK", "SKYLINE BLUE",
"NAVY", NA, NA, NA,
"BLACK", NA, "GRAY", NA,
"BLACK", "AURORA GREEN", NA, "KNICKS BLACK",
"YELLOW", NA, "SILVER", "GRAY",
NA, NA, NA, "GOLD",
NA, NA ),
col5 = c(NA, "#000000", NA, NA, NA, NA, NA, NA,
NA, NA, NA, NA, NA, NA, NA, NA,
NA, NA, NA, NA, NA, NA, NA, "#F9AD1B",
NA, NA, NA, NA, NA, NA ),
name_col5 = c(NA, "CELTICS BLACK", NA, NA, NA,
NA, NA, NA, NA, NA,
NA, NA, NA, NA, NA,
NA, NA, NA, NA, NA,
NA, NA, NA, "YELLOW", NA,
NA, NA, NA, NA, NA ),
col6 = c(NA, NA, NA, NA, NA, NA, NA, NA,
NA, NA, NA, NA, NA, NA, NA, NA,
NA, NA, NA, NA, NA, NA, NA, "#B95915",
NA, NA, NA, NA, NA, NA ),
name_col6 = c(NA, NA, NA, NA, NA, NA,
NA, NA, NA, NA, NA, NA,
NA, NA, NA, NA, NA, NA,
NA, NA, NA, NA, NA, "DARK ORANGE",
NA, NA, NA, NA, NA, NA ),
col7 = c(NA, NA, NA, NA, NA, NA, NA, NA,
NA, NA, NA, NA, NA, NA, NA, NA,
NA, NA, NA, NA, NA, NA, NA, "#BEC0C2",
NA, NA, NA, NA, NA, NA ),
name_col7 = c(NA, NA, NA, NA, NA, NA,
NA, NA, NA, NA, NA, NA,
NA, NA, NA, NA, NA, NA,
NA, NA, NA, NA, NA, "LIGHT GRAY",
NA, NA, NA, NA, NA, NA))
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]]
max <- team %>%
filter(RATING == max(RATING)) %>%
select(RATING)
max <- max[[1]]
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 Luck-Adjusted ", 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")
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 Luck-Adjusted ", 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: BBall Index Data & Tools\nTelegram: @NBAatlantic, twitter: @vshufinskiy"))
animate(anim, fps = 5, duration = 5, width = 1280, height = 720,
renderer = gifski_renderer(paste0(unique(team$TEAM_NAME), quo_name(quo_rating), ".gif")))
}
rolling_offnet_rating_nba(rating1, ORTG, "GSW")
Результат: https://c.radikal.ru/c40/1907/c8/37e210e3f31b.gif