Подстановка символьного векторного столбца в несколько столбцов

Question

У меня есть следующий тиббл:

colours = tribble(
  ~all,
  c('blue','green', 'red', 'pink', 'yellow', 'gold', 'orange', 'ivory', 'brown', 'beige'),
  c('green', 'red', 'pink', 'orange', 'ivory', 'beige')
)

Я хотел бы разделить цвета на несколько столбцов в соответствии с их семейством цветов: Cool, Warm, Neutral, с одним столбцом для каждого семейства.

Я могу сделать это, используя mutate с map и str_subset:

colours %>%
  mutate(
    'Cool' = map(all, ~str_subset(., '^(blue|green)$')), 
    'Warm' = map(all, ~str_subset(., '^(red|pink|yellow|gold|orange)$')),
    'Neutral' = map(all, ~str_subset(., '^(ivory|brown|beige)$'))
  )

# A tibble: 2 x 4
  all        Cool      Warm      Neutral  
  <list>     <list>    <list>    <list>   
1 <chr [10]> <chr [2]> <chr [5]> <chr [3]>
2 <chr [6]>  <chr [1]> <chr [3]> <chr [2]>

Но мне было интересно, есть ли более лаконичный способ достижения того же результата? Я пробовал tidyr::extract(), но, похоже, не могу понять правильное выражение:

colours %>% 
  mutate(all = map(all, ~paste(., collapse = ' '))) %>% 
  extract(all, into = c('Cool', 'Warm', 'Neutral'), 
          regex = '(blue|green)|(red|pink|yellow|gold|orange)|(ivory|brown|beige)')

Я предполагаю, что это неправильно, потому что оператор OR соответствует отдельным словам в каждой группе, а не разбивает строку на три подстроки, которые содержат все совпадающие слова для каждой группы? Вот демоверсия .

Answer 1

Я был почти уверен, что extract не сработает, но с правильным регулярным выражением. Это на самом деле не намного более "кратко", чем ваше первое решение, но я думаю, что оно, вероятно, настолько кратко, насколько это возможно. (Если вы хотите сократить вещи, подумайте о сворачивании ваших цветов в двухсимвольный символьный вектор, а не в фрейм данных со столбцом списка.)

Проблема с вашим шаблоном регулярных выражений заключается в использовании |. Вы хотите настроить таргетинг на наборы слов, а не на «x OR y OR z», как это делает ваш шаблон, и поэтому вы получаете только одно совпадение на строку. Для создания коллекции возможных совпадений используйте []. Включите * для совпадений "ноль или более". Используя данные вашего примера выше:

library(tidyverse)

colours %>% 
    mutate(all = map(all, str_c, collapse = " ")) %>% 
    extract(all, c("cool", "warm", "neutral"),
            "([blue green]*) ([red pink yellow gold orange]*) ([ivory brown beige]*)",
            remove = F # Include the `all` column.
    )

#### OUTPUT ####

# A tibble: 2 x 4
  all       cool       warm                        neutral          
  <list>    <chr>      <chr>                       <chr>            
1 <chr [1]> blue green red pink yellow gold orange ivory brown beige
2 <chr [1]> green      red pink orange             ivory beige      

Основной оговоркой является то, что цветовые категории должны быть в правильном порядке, т. Е. Строка должна содержать группы цветовых слов в порядке cool → warm → neutral. Если они случайные, это не сработает. На самом деле, я не думаю, что extract работал бы больше, если бы цветные слова были случайными, потому что нет способа извлечь отдельные слова и затем объединить их. Вы также потеряете свои столбцы списка - если это важно для вас.

Если порядок не гарантирован, или есть вероятность того, что некоторые слова категории отсутствуют, вы можете сделать что-то вроде следующего. Используя случайную выборку слов категории (обратите внимание, что я опускаю столбцы списка, чтобы вы могли видеть, что происходит):

col_rand <- tribble(
    ~all,
    sample(c('blue','green', 'red', 'pink', 'yellow', 'gold', 'orange', 'ivory', 'brown', 'beige'), 5),
    sample(c('green', 'red', 'pink', 'orange', 'ivory', 'beige'), 4)
) %>% 
    mutate(all = map(all, str_c, collapse = " ") %>% unlist())

#### OUTPUT ####

# A tibble: 2 x 1
  all                       
  <chr>                     
1 blue yellow red beige pink
2 ivory pink beige orange   

И со следующими рисунками:

patts <- c(cool = "blue|green",
           warm = "red|pink|yellow|gold|orange",
           neutral = "ivory|brown|beige"
           )

Вы можете сделать что-то вроде следующего, который извлекает совпадения и объединяет их, или возвращает NA, если совпадений нет:

library(magrittr)

unlist(col_rand$all) %>% 
    map_dfr(function(x) {str_extract_all(x, patts) %>%
            map(function(x) ifelse(length(x) == 0,
                                   NA,
                                   str_c(x, collapse = " ")
                                   )
                ) %>% 
            bind_cols()}) %>% 
    set_colnames(names(patts)) %>% bind_cols(col_rand, .)

#### OUTPUT ####

# A tibble: 2 x 4
  all                        cool  warm            neutral    
  <chr>                      <chr> <chr>           <chr>      
1 blue yellow red beige pink blue  yellow red pink beige      
2 ivory pink beige orange    NA    pink orange     ivory beige

Обратите внимание, что библиотека magrittr загружена для set_colnames. Если вы загрузите magrittr после tidyverse / tidyr, вам нужно будет использовать tidyr::extract() выше, потому что обе библиотеки имеют функцию extract.