Итеративное создание нескольких новых столбцов в фрейме данных - PullRequest
Новая
       26

Итеративное создание нескольких новых столбцов в фрейме данных

2 голосов
/ 18 июня 2020

- Небольшие изменения в тестовых данных. Столбцы больше не группируются по раундам, а вместо этого группируются по командам, как в случае реального набора данных.

Я пробовал различные методы для создания нескольких новых столбцов, сводя к минимуму повторение в коде. Мой первоначальный и успешный метод требует чрезмерного копирования и вставки, но я хотел бы минимизировать это насколько возможно. Ниже приведены примерные данные для проблемы: 

df <- tribble(~R1TeamX, ~R2TeamX,~R3TeamX, ~R1TeamY,~R2TeamY, ~R3TeamY, 
              10, 11, 12, 15, 19, 20, 
              11, 13, 14, 25, 18, 15)

Этот пример данных для трех раундов с оценками как для команды X, так и для команды Y. Я хочу создать дополнительные столбцы, чтобы найти разницу между оценками Команда X и Y. Настоящий набор данных содержит более 30 раундов.

Мое первоначальное решение использовало mutate и работает следующим образом: 

df <- df %>%
mutate(R1Diff = R1TeamX - R1TeamY, 
       R2Diff = R2TeamX - R2TeamY, 
       R3Diff = R3TeamX - R3TeamY)

Хотя это работает, оно не масштабируемо. Я попытался сократить это количество кода до меньшего, используя str_ c & mutate, но не могу определить правильный метод цикла, чтобы это работало для нескольких строк кода. Ниже представлена ​​моя попытка стандартизировать код на данный момент: 

teamx <- str_c("R", 1:3, "TeamX")
teamy <- str_c("R", 1:3, "TeamY")
round_diff <- str_c("R", 1:3, "Diff")

df <- df %>%
  mutate(!!round_diff[1] := UQ(parse_quo(teamx[1], global_env())) - UQ(parse_quo(teamy[1], global_env())),
         !!round_diff[2] := UQ(parse_quo(teamx[2], global_env())) - UQ(parse_quo(teamy[2], global_env())),
         !!round_diff[3] := UQ(parse_quo(teamx[3], global_env())) - UQ(parse_quo(teamy[3], global_env())))

Хотя требуется дополнительный код, это до некоторой степени стандартизирует мой ввод, уменьшая часть работы ног, но я знаю, что должен быть какой-то способ уменьшить это в одну строку. Я исследовал mutate_at и циклы безрезультатно. Я подозреваю, что эту проблему можно решить с помощью purrr :: map, но у меня достаточно возможностей в этой области, чтобы определить правильный подход.

Любая помощь будет принята с благодарностью.

Ответы [ 3 ]

1 голос
/ 18 июня 2020

попробуйте сделать так 

library(tidyverse)
df %>% 
  mutate(id = row_number()) %>% 
  pivot_longer(
    -id,
    names_to = c("set", ".value"), 
    names_pattern = "(R\\d+Team)(X|Y)"
               ) %>% 
  mutate(Diff = X - Y) %>% 
  pivot_longer(-c(id, set)) %>% 
  pivot_wider(id, names_from = c(set, name), values_from = value, names_sep = "")
1 голос
/ 18 июня 2020

Вот решение, которое я считаю надежным в отношении количества раундов, количества противников Команды X и порядка, в котором сохраняются результаты.

Во-первых, приведите данные в порядок: удалить информация о командах и раундах из названий столбцов. 

newDF <- df %>% 
            mutate(id = row_number()) %>% 
            pivot_longer(
              -id,
              names_to = c("Round", "Team"), 
              names_pattern = "R(\\d+)Team(X|Y)",
              values_to="Score"
           )

Теперь вычислите разницу в баллах 

newDF %>% 
  # Calculate difference in scores
  mutate(Team=ifelse(Team == "X", Team, "Opponent")) %>% 
  pivot_wider(values_from=Score, names_from=Team) %>% 
  mutate(Diff=X - Opponent) %>% 
  select(-Opponent) %>% 
  # Bring in identity of oponent
  left_join(
    newDF %>% 
      filter(Team != "X") %>% 
      select(-Score) %>% 
      rename(Opposition=Team),
      by=c("id", "Round")
  )

Давать 

# A tibble: 6 x 5
     id Round     X  Diff Opposition
  <int> <chr> <dbl> <dbl> <chr>     
1     1 1        10    -5 Y         
2     1 2        11    -8 Y         
3     1 3        12    -8 Y         
4     2 1        11   -14 Y         
5     2 2        13    -5 Y         
6     2 3        14    -1 Y

на основе пересмотренных входных данных OP.

1 голос
/ 18 июня 2020

Хотя это возможно сделать в функциях dplyr и tidyr, помните, что у вас все еще есть открытые полезные базовые параметры R. Этот метод использует lapply и предполагает, что ваши столбцы чередуются между командой X и командой Y 

seq(length(df)/2) %>%
  lapply(function(x) df[[x]] - df[[x + 1]]) %>%
  as.data.frame() %>%
  setNames(paste0("R", seq(length(df)/2), "Diff")) %>%
  cbind(df,.)

#>   R1TeamX R1TeamY R2TeamX R2TeamY R3TeamX R3TeamY R1Diff R2Diff R3Diff
#> 1      10      11      12      15      19      20     -1     -1     -3
#> 2      11      13      14      25      18      15     -2     -1    -11
...