Блог

Я работаю с данными этого баскетбольного матча с фреймом данных games, содержащим около 50 000 строк. Я пытаюсь сравнить статистику каждой команды (A и B) в каждой игре.

У меня есть другой фрейм данных под названием TeamStats, который содержит около 3000 строк, каждая с командами из каждого сезона.

На данный момент я собрал код следующим образом:

     for (i in 1:nrow(games)) {
  if (length(which(((teamStats$Year == games$Season[i])==1) amp; (teamStats$teamID == games$teamA[i]))) == 1) {
    selectTeamA <- teamStats[which(((teamStats$Year == games$Season[i])==1) amp; (teamStats$teamID == games$teamA[i])),4:45]
  } else {
    selectTeamA <- as.numeric(rep(NA, ncol(differences)))
  }
  if (length(which(((teamStats$Year == games$Season[i])==1) amp; (teamStats$teamID == games$teamB[i]))) == 1) {
    selectTeamB <- teamStats[which(((teamStats$Year == games$Season[i])==1) amp; (teamStats$teamID == games$teamB[i])),4:45]
  } else {
    selectTeamB <- as.numeric(rep(NA, ncol(differences)))
  }

  differences[i,] <- selectTeamA - selectTeamB
}
  

По сути, этот код выполняет поиск правильного TeamID для каждой команды A и B после установки правильного сезона. Поскольку каждая команда за каждый сезон отсутствует в teamstats, я пока заполнил недостающие строки значениями NA. Фрейм данных «различия» — это пустой фрейм данных, который будет заполнен различиями в статистике команд A и B из цикла for.

Чтобы дать вам представление о данных:

Игры — первые 6 строк

            Season teamA teamB winner scoreA scoreB
108123   2010  1143  1293      A     75     70
108124   2010  1198  1314      B     72     88
108125   2010  1108  1326      B     60    100
108126   2010  1107  1393      B     43     75
108127   2010  1143  1178      A     95     61
  

TeamStats — первые 6 строк и только первые 6 столбцов для свободного места — множество столбцов с разной статистикой во всем фрейме данных. Код находит правильную строку для TeamID, а затем вычитает столбцы статистики, такие как G W L и т. Д

               School Year teamID  G  W  L
1  abilene christian 2018   1101 32 16 16
2          air force 2018   1102 31 12 19
3              akron 2018   1103 32 14 18
4        alabama aamp;m 2018   1105 31  3 28
5 alabama-birmingham 2018   1412 33 20 13
  

И в завершение этого очень длинного поста, мой вопрос. Мой код цикла for работает и заполняет фрейм данных differences. Проблема в том, что для запуска этого кода требуется 20-30 минут. У меня не очень большой опыт работы с таким количеством данных. Есть ли метод, которого я не знаю? Как я могу переписать этот код более эффективным способом?

Вот подход с использованием tidyverse пакетов, который, я ожидаю, должен быть намного быстрее, чем решение цикла в OP. Скорость (я ожидаю) достигается за счет большего использования операций соединения с базой данных (например, base merge или dplyr left_join ) для соединения двух таблиц.

 library(tidyverse)

# First, use the first few columns from the `games` table, and convert to long format with
#   a row for each team, and a label column `team_cat` telling us if it's a teamA or teamB.
stat_differences <- games %>%
  select(row, Season, teamA, teamB)  %>% 
  gather(team_cat, teamID, teamA:teamB) %>%  

# Join to the teamStats table to bring in the team's total stats for that year
  left_join(teamStats %>% select(-row),    # We don't care about this "row"
            by = c("teamID", "Season" = "Year")) %>%

# Now I want to reverse the stats' sign if it's a teamB. To make this simpler, I gather
#   all the stats into long format so that we can do the reversal on all of them, and 
#   then spread back out.
  gather(stat, value, G:L) %>%
  mutate(value = if_else(team_cat == "teamB", value * -1, value * 1)) %>%
  spread(stat, value) %>%

# Get the difference in stats for each row in the original games table.
  group_by(row) %>%
  summarise_at(vars(G:W), sum)

# Finally, add the output to the original table
output <- games %>% 
  left_join(stat_differences)
  

Чтобы проверить это, я изменил приведенные данные образца таким образом, чтобы две таблицы были связаны друг с другом:

 games <- read.table(header = T, stringsAsFactors = F,
  text = "row           Season teamA teamB winner scoreA scoreB
108123   2010  1143  1293      A     75     70
108124   2010  1198  1314      B     72     88
108125   2010  1108  1326      B     60    100")

teamStats <- read.table(header = T, stringsAsFactors = F,
  text = "row   School Year teamID  G  W  L
1  abilene_christian 2010   1143 32 16 16
2          air_force 2010   1293 31 12 19
3              akron 2010   1314 32 14 18
4        alabama_aamp;m 2010   1198 31  3 28
5 alabama-birmingham 2010   1108 33 20 13
6       made_up_team 2018   1326 160 150 10    # To confirm getting right season
7       made_up_team 2010   1326 60 50 10"
)
  

Затем я получаю следующий вывод, который, кажется, имеет смысл.
(Я только что понял, что примененный мной метод сбора / изменения / распространения изменил порядок столбцов; если у меня будет время, я мог бы попытаться использовать mutate_if для сохранения порядка.)

 > output
     row Season teamA teamB winner scoreA scoreB   G  L   W
1 108123   2010  1143  1293      A     75     70   1 -3   4
2 108124   2010  1198  1314      B     72     88  -1 10 -11
3 108125   2010  1108  1326      B     60    100 -27  3 -30
  

Один из подходов заключается в объединении games и teamStats , в качестве альтернативы перебору строк.

Некоторый код для репликации вашей настройки, чтобы создать минимальный рабочий пример:

 library(dplyr)
library(purrr)

set.seed(123)
n_games <- 50000
n_teams <- 400
n_years <- 10

games <- data.frame(Season = rep(2005:(2005   n_years - 1),
                                 each = n_games / n_years)) %>%
  mutate(teamA = sample(1000:(1000   n_teams - 1), n_games, r = TRUE),
         teamB = map_int(teamA, ~sample(setdiff(1000:(1000   n_teams - 1), .), 1)),
         scoreA = as.integer(rnorm(n_games, 80, 20)),
         scoreB = as.integer(rnorm(n_games, 80, 20)),
         scoreB = ifelse(scoreA == scoreB, scoreA   sample(c(-1, 1), n_games, r = TRUE), scoreB),
         winner = ifelse(scoreA > scoreB, "A", "B"))

gen_random_string <- function(...) {
  paste(sample(c(letters, " "), rpois(1, 10), r = TRUE), collapse = "")
}

schools_ids <- data.frame(teamID = 1000:(1000   n_teams - 1)) %>%
  mutate(School = map_chr(teamID, gen_random_string))

teamStats <- data.frame(Year = rep(2005:(2005   n_years - 1), each = 300)) %>%
  mutate(teamID = as.vector(replicate(n_years, sample(schools_ids$teamID, 300))),
         G = 32, W = rpois(length(teamID), 16), L = G - W) %>%
  left_join(schools_ids)
  

У нас есть games с 50 тыс. строк и TeamStats с 3 тыс. строк. Теперь мы сворачиваемся teamStats в tibble с помощью Year и teamID :

 teamStats <- teamStats %>%
  group_by(Year, teamID) %>%
  nest()

# # A tibble: 3,000 x 3
#     Year teamID data            
#    <int>  <int> <list>          
#  1  2005   1321 <tibble [1 x 4]>
#  2  2005   1192 <tibble [1 x 4]>
#  3  2005   1074 <tibble [1 x 4]>
# <snip>
  

Создайте небольшую удобную функцию для вычисления различий:

 calculate_diff <- function(x, y) {
  if (is.null(x) | is.null(y)) {
    data.frame(G = NA, W = NA, L = NA)
  } else {
    x[, 1:3] - y[, 1:3]
  }
}
  

Теперь мы (1) соединяем (или объединяем) games с teamStats , (2) вычисляем различия, используя объединенный набор данных, и (3) unnest (или сворачиваем) фрейм данных.

 start <- Sys.time()
differences <- games %>%
  left_join(teamStats, c("Season" = "Year", "teamA" = "teamID")) %>%
  rename(teamA_stats = data) %>%
  left_join(teamStats, c("Season" = "Year", "teamB" = "teamID")) %>%
  rename(teamB_stats = data) %>%
  mutate(diff = map2(teamA_stats, teamB_stats, calculate_diff)) %>%
  select(Season, teamA, teamB, diff) %>%
  unnest()
difftime(Sys.time(), start)
# Time difference of 11.27832 secs
  

результатом

 head(differences)
#   Season teamA teamB  G  W  L
# 1   2005  1115  1085 NA NA NA
# 2   2005  1315  1177 NA NA NA
# 3   2005  1163  1051  0 -9  9
# 4   2005  1353  1190  0 -4  4
# 5   2005  1376  1286 NA NA NA
# 6   2005  1018  1362  0 -1  1