Заранее спасибо за помощь в этом.Я не уверен, что использую apply неправильно или просто нарушаю другие правила, которые замедляют мой код.Любая помощь приветствуется.
Обзор: У меня есть данные о баскетболе, где каждый ряд является моментом в баскетбольном матче и включает в себя 10 игроков на площадке, их команды, игру, а также сколько минут в игре.игра (1 - 40), в которой находится ряд.Используя эти данные, я рассчитываю для каждого игрока процент игр своей команды, которые они провели на площадке в течение 1–40 минут.
Например, если команда Джо сыграла 20 игр, иесли в 13 из этих игр Джо был замечен в данных на 5-й минуте игры, то мы бы сказали, что Джо был замечен на корте на 5-й минуте 65% игр его команды.Я вычисляю это для каждого игрока, для каждого сезона, для каждой из 1-40 минут, в моих не очень маленьких данных, и сталкиваюсь с проблемами производительности.Вот функция, которую я в настоящее время имею для этого:
library(dplyr)
# Raw Data Is Play-By-Play Data - Each Row contains stats for a pl (combination of 5 basketball players)
sheets_url <- 'https://docs.google.com/spreadsheets/d/1xmzaF6tpzVpjOmgfwHwFM_JE8LUszofjj25A5P0P21o/export?format=csv&id=1xmzaF6tpzVpjOmgfwHwFM_JE8LUszofjj25A5P0P21o&gid=630752085'
on.ct.data <- httr::content(httr::GET(url = sheets_url))
computeOnCourtByMinutePcts <- function(on.ct.data) {
# Create Dataframe With Number Of Games Played By Team Each Season
num.home.team.games <- on.ct.data %>%
dplyr::group_by(homeTeamId, season) %>%
dplyr::summarise(count = length(unique(gameId)))
num.away.team.games <- on.ct.data %>%
dplyr::group_by(awayTeamId, season) %>%
dplyr::summarise(count = length(unique(gameId)))
num.team.games <- num.home.team.games %>%
dplyr::full_join(num.away.team.games, by = c('homeTeamId'='awayTeamId', 'season'='season')) %>%
dplyr::mutate(gamesPlayed = rowSums(cbind(count.x, count.y), na.rm = TRUE)) %>%
dplyr::rename(teamId = homeTeamId) %>%
dplyr::mutate(season = as.character(season)) %>%
dplyr::select(teamId, season, gamesPlayed)
# Create Dataframe With Players By Season - Seems kind of bulky as well
all.player.season.apperances <- rbind(
on.ct.data %>% dplyr::select(homeTeamId, onCtHomeId1, season) %>% dplyr::rename(playerId = onCtHomeId1, teamId = homeTeamId),
on.ct.data %>% dplyr::select(homeTeamId, onCtHomeId2, season) %>% dplyr::rename(playerId = onCtHomeId2, teamId = homeTeamId),
on.ct.data %>% dplyr::select(homeTeamId, onCtHomeId3, season) %>% dplyr::rename(playerId = onCtHomeId3, teamId = homeTeamId),
on.ct.data %>% dplyr::select(homeTeamId, onCtHomeId4, season) %>% dplyr::rename(playerId = onCtHomeId4, teamId = homeTeamId),
on.ct.data %>% dplyr::select(homeTeamId, onCtHomeId5, season) %>% dplyr::rename(playerId = onCtHomeId5, teamId = homeTeamId),
on.ct.data %>% dplyr::select(awayTeamId, onCtAwayId1, season) %>% dplyr::rename(playerId = onCtAwayId1, teamId = awayTeamId),
on.ct.data %>% dplyr::select(awayTeamId, onCtAwayId2, season) %>% dplyr::rename(playerId = onCtAwayId2, teamId = awayTeamId),
on.ct.data %>% dplyr::select(awayTeamId, onCtAwayId3, season) %>% dplyr::rename(playerId = onCtAwayId3, teamId = awayTeamId),
on.ct.data %>% dplyr::select(awayTeamId, onCtAwayId4, season) %>% dplyr::rename(playerId = onCtAwayId4, teamId = awayTeamId),
on.ct.data %>% dplyr::select(awayTeamId, onCtAwayId5, season) %>% dplyr::rename(playerId = onCtAwayId5, teamId = awayTeamId)) %>%
dplyr::distinct(teamId, playerId, season) %>%
dplyr::filter(!is.na(playerId))
# For Each Player-Season, Compute Number Of Games On Court at each minute in game - this is the bad Apply
playing.time.breakdowns <- apply(X = all.player.season.apperances, MARGIN = 1, FUN = function(thisRow) {
# Set Player / Season Variables
thisPlayerId = thisRow[2]
thisSeason = thisRow[3]
# Filter for each unique minute of each game with this player on court
on.court.df = on.ct.data %>%
dplyr::filter(onCtHomeId1 == thisPlayerId | onCtHomeId2 == thisPlayerId | onCtHomeId3 == thisPlayerId | onCtHomeId4 == thisPlayerId | onCtHomeId5 == thisPlayerId |
onCtAwayId1 == thisPlayerId | onCtAwayId2 == thisPlayerId | onCtAwayId3 == thisPlayerId | onCtAwayId4 == thisPlayerId | onCtAwayId5 == thisPlayerId) %>%
dplyr::filter(season == thisSeason) %>%
dplyr::filter(!duplicated(paste0(gameId, minNumIntoGame)))
# Turn This Into a table of minutes on court by game
thisTable <- table(on.court.df$minNumIntoGame)
this.player.distrubution.df <- data.frame(
playerId = thisRow[2],
teamId = thisRow[1],
season = thisRow[3],
minNumIntoGame = as.integer(names(thisTable)),
numGamesAtMinNum = unname(thisTable) %>% as.vector(),
stringsAsFactors = FALSE
)
# 40 minutes in basketball game, so previous dataframe needs 40 rows
if(length(which(!(1:40 %in% this.player.distrubution.df$minNumIntoGame))) > 0) {
zero.mins.played.df <- data.frame(
playerId = thisRow[2],
teamId = thisRow[1],
season = thisRow[3],
minNumIntoGame = which(!(1:40 %in% this.player.distrubution.df$minNumIntoGame)),
numGamesAtMinNum = 0,
stringsAsFactors = FALSE
)
this.player.distrubution.df <- plyr::rbind.fill(this.player.distrubution.df, zero.mins.played.df) %>% dplyr::arrange(minNumIntoGame)
}
# and return
return(this.player.distrubution.df)
})
# Combine the output into one dataframe
playing.time.breakdowns <- playing.time.breakdowns %>% do.call("rbind", .)
# Join on Team-Games played
playing.time.breakdowns <- playing.time.breakdowns %>%
dplyr::left_join(num.team.games, by = c("teamId"="teamId", "season"="season")) %>%
dplyr::rename(teamGamesPlayed = gamesPlayed)
# Compute pct of games played
playing.time.breakdowns <- playing.time.breakdowns %>%
dplyr::mutate(pctMinNumPlayed = round(numGamesAtMinNum / teamGamesPlayed, 3))
# Handle OT (minNumIntoGame > 40) needs a lower gamesPlayed denominator...
# And Return
return(playing.time.breakdowns);
}
on.ct.by.min <- computeOnCourtByMinutePcts(on.ct.data)
Таким образом, код выполняет следующее:
- Создает начальные кадры данных всех уникальных сезонов игроков и командныхсезоны.Для командных сезонов используйте данные pbp для расчета сыгранных игр.
- Применить - для каждого игрового сезона: (a) найдите каждый экземпляр игрока на площадке (в одном из столбцов 10
onCt)) для каждой минуты каждой игры, (b) конвертируйте это в таблицу, которая показывает количество игр, в которых игрок находился на корте в каждую из 1-40 минут. - Польский подъем и возврат.Соедините несколько таблиц вместе и вычислите соответствующие проценты.
Обратите внимание, что может быть проще следовать функции apply, запустив ее вручную для одной строки all.player.season.appearances.Установите thisRow на любую строку в кадре данных и постройте код построчно для большей ясности.
Чтобы выделить проблемы с медленным кодом, я загрузил большой кусок play-by-play / on-Сортируйте данные на листы Google, сделайте их общедоступными и включите ссылку для загрузки данных в приведенном выше коде.В Google Sheets хранится ~ 1/2 моих текущих данных, однако, как ожидается, общий объем данных в ближайшем будущем увеличится в 10 раз, и в настоящее время выполнение кода на моем компьютере занимает ~ 8 минут.Это сценарий, который нужно запускать ежедневно и довольно быстро, и я не могу позволить, чтобы эта одна функция занимала 80 минут.
Такое ощущение, что мой apply() вызов выполнен неправильно, как будто его нетбыстрее, чем обычный цикл.Я не уверен, что подать заявку нужно вообще, и на самом деле, я не думаю, что это так.Но последние 24 часа я боролась с мыслями о том, как улучшить эту функцию, но не повезло.Здесь должен быть лучший подход!
Редактировать: У меня есть небольшая ошибка в воспроизводимом примере, над которым я сейчас работаю.Edit2: исправлена ошибка, из-за которой создавались NA в кадре данных num.team.games.Я просто запустил код, и он, кажется, работает правильно.Есть ~ 600 строк вывода, где teamId равен NA, и не о чем беспокоиться.
Edit3: Похоже, что каждая итерация применения занимает 0,06 секунды, а количество 5312строк в кадре данных, что составляет ~ 8 минут времени выполнения.Должен ли я пытаться уменьшить это 0,06 до <0,01 или отказаться от всего этого подхода?Это основной вопрос, в котором я не уверен ... </p>