Блог

Мне нужно изменить сложную таблицу из строк сложенных данных выборов в четко отформатированные столбцы, содержащие всю информацию. У меня возникли проблемы с автоматизацией этого.

Вот простая версия входных данных. Обратите внимание, что в этом примере всего 2 выборов; в реальных данных их много, поэтому код необходимо обобщить:

 input <- 
  structure(list(a = c("2020 ge", "winner", NA, "2016 ge", "winner"
), b = c(NA, "orange (cat)", NA, NA, "peach (kitten)"), c = c(NA, 
"runner up", NA, NA, "runner up"), d = c(NA, "peach (kitten)", NA, 
NA, "orange (cat)"), e = c(NA, "margin", NA, NA, "margin"), f = c(NA, 
100, NA, NA, 150)), row.names = c(NA, 5L), class = "data.frame")

 

И это результат, который я хотел бы:

 output <- 
  structure(list(`2019_winner_name` = "orange", `2020_winner_party` = "cat", 
    `2020_runner_up_name` = "peach", `2020_runner_up_party` = "kitten", 
    `2020_margin` = 100, `2016_winner_name` = "peach", `2016_winner_party` = "kitten", 
    `2016_runner_up_name` = "orange", `2016_runner_up_party` = "cat", 
    `2016_margin` = 150), row.names = 1L, class = "data.frame")
 

Вот то, что я пробовал до сих пор, и это работает в течение одного года:

 # test data
test <-
  input %>%
  slice(1:2) %>%
  fill(c(b, c, d, e, f), .direction = c("up"))

# select first row
row_one <-
  test %>%
  select(a) %>%
  slice(1)

# select year
year  <- 
  str_extract(row_one$a, "^([0-9]*)")

# select second row as name
row_two <-
  test %>%
  select(a) %>%
  slice(2) %>%
  as.character()

# bring back to test data
test <- 
  test %>%
  mutate(a  = row_two) %>%
  slice(1) %>%
  add_row() %>%
  fill(c(b, d, f)) %>%
  mutate(a = ifelse(is.na(a), b, a),
         c = ifelse(is.na(c), d, c),
         e = ifelse(is.na(e), f, e)) %>%
  select(a, c, e) %>%
  row_to_names(1) %>%
  rename_all(funs(paste0(year, "_", .)))

# extract party variable
test <- 
  test %>%
  mutate_at(vars(contains("winner"), contains("runner")), 
            funs(party = str_extract(., "(?<=\(). ?(?=\))"))) %>%
  mutate_at(vars(ends_with("winner"), ends_with("up")), 
            funs(name = str_extract(., "([^()]*)")))
 

Какой был бы более простой и лаконичный способ сделать это, учитывая необычный формат данных? Как я могу автоматизировать это, чтобы я мог запускать его в течение нескольких лет выборов?

Спасибо.

Во-первых, я согласен с @deschen в том, что это очень грязные данные. Вместо того, чтобы пытаться привести в порядок / изменить форму данных, как указано, я бы рекомендовал изучить, можно ли проанализировать исходные данные лучшим (более аккуратным) способом.

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

 library(tidyverse)

# Define a convenience function that turns a vector with an even number of elements
# into a named vector where every odd element is the name of the following even element
to_named_vec <- function(x) {
    if (length(x) == 1) return(magrittr::set_names(x, "margin")) 
    nm <- x[c(TRUE, FALSE)]
    vec <-x[c(FALSE, TRUE)]
    return(magrittr::set_names(vec, nm))
}

# First convert the input into a nested `list`
lst <- input %>%   
    t() %>%
    as.character() %>%
    discard(is.na) %>%
    split(., cumsum(str_detect(., "\d{4}"))) %>%
    map(~ .x %>% 
            str_remove(" ge") %>%
            stringi::stri_replace_all_regex("(\w )\s\((\w )\)", "name_$1_party_$2") %>% 
            str_split("_") %>% 
            unlist()) %>%
    magrittr::set_names(map_chr(., head, 1)) %>%
    map(~ .x[-1] %>% 
            split(cumsum(str_detect(.x[-1], "(winner|runner up|margin)"))) %>%
            magrittr::set_names(map_chr(., head, 1)) %>%
            map(~ .x %>% tail(-1) %>% to_named_vec() %>% bind_rows()))
    
# The last step involves `unlist`ing the nested `list`, tidying the names and 
# converting the named vector into a `tibble` with `bind_rows`.
lst %>%
    unlist() %>%
    set_names(., str_replace_all(names(.), "\.", "_")) %>%
    set_names(., str_replace(names(.), "_margin", "")) %>%
    bind_rows()
## A tibble: 1 x 10
#`2020_winner_na~ `2020_winner_pa~ `2020_runner up~ `2020_runner up~ `2020_margin` `2016_winner_na~
#    <chr>            <chr>            <chr>            <chr>            <chr>         <chr>           
#    1 orange           cat              peach            kitten           100           peach           
## ... with 4 more variables: `2016_winner_party` <chr>, `2016_runner up_name` <chr>, `2016_runner
##   up_party` <chr>, `2016_margin` <chr>
 

Лучше всего пошагово просматривать код построчно, чтобы понять, что делает каждый шаг; примерно,

• мы транспонируем input ,
• преобразуйте полученную матрицу в character вектор, отбросьте NA s и
• разделите вектор по появлению » d {4}» (т. Е. Года GE).

Затем мы работаем с каждым list элементом отдельно, путем

• удаление строки «ge»,
• замена вхождений формы «orange (cat)» на «name_orange_party_cat»,
• разделение записей на «_».

Остальное зависит от присвоения вложенным list элементам собственных имен, которые исходят из вектора list самих элементов.

Последний шаг включает unlist в себя редактирование вложенных list и приведение в порядок имен именованного вектора, чтобы отразить те, которые вы ожидали output .