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

#r #function #dplyr #lapply

Вопрос:

Я работаю с большим набором данных, где большая часть данных была введена дважды. Это означает, что многие переменные представлены парами столбцов: column.1 с данными, введенными одним пользователем, и column.2 где те же данные были введены другим пользователем. Я хочу создать столбец «master» с именем simply column , который сначала извлекается из column.1 , а затем, если column.1 есть NA , извлекается из column.2 .

Вот пример того, что я пытаюсь сделать с составными данными:

 mydata <- data.frame(name = c("Sarah","Ella","Carmen","Dinah","Billie"),
                     cheese.1 = c(1,4,NA,6,NA),
                     cheese.2 = c(1,4,3,5,NA),
                     milk.1 = c(NA,2,0,4,NA),
                     milk.2 = c(1,2,1,4,2),
                     tofu.1 = c("yum","yum",NA,"gross", NA),
                     tofu.2 = c("gross", "yum", "yum", NA, "gross"))
 

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

 mydata %>% mutate(cheese = ifelse(is.na(cheese.1), cheese.2, cheese.1))

#OUTPUT:

    name cheese.1 cheese.2 milk.1 milk.2 tofu.1 tofu.2 cheese
1  Sarah        1        1     NA      1    yum  gross      1
2   Ella        4        4      2      2    yum    yum      4
3 Carmen       NA        3      0      1   <NA>    yum      3
4  Dinah        6        5      4      4  gross   <NA>      6
5 Billie       NA       NA     NA      2   <NA>  gross     NA
 

Однако я хочу автоматизировать процесс, а не выполнять каждый вручную. Ниже приведена моя попытка автоматизировать процесс, используя список ( col.list ) пар столбцов, для которых я хочу создать новые «основные» столбцы:

 col.list = c("cheese","milk","tofu")

lapply(col.list, FUN = function(x) {
  v <- as.name({{x}})
  v.1 <- as.name(paste0({{x}}, ".1"))
  v.2 <- as.name(paste0(({{x}}), ".2"))
  mydata %>% mutate(v = ifelse(is.na({{v.1}}), {{v.2}}, {{v.1}}))
})

#OUTPUT:

[[1]]
    name cheese.1 cheese.2 milk.1 milk.2 tofu.1 tofu.2  v
1  Sarah        1        1     NA      1    yum  gross  1
2   Ella        4        4      2      2    yum    yum  4
3 Carmen       NA        3      0      1   <NA>    yum  3
4  Dinah        6        5      4      4  gross   <NA>  6
5 Billie       NA       NA     NA      2   <NA>  gross NA

[[2]]
    name cheese.1 cheese.2 milk.1 milk.2 tofu.1 tofu.2 v
1  Sarah        1        1     NA      1    yum  gross 1
2   Ella        4        4      2      2    yum    yum 2
3 Carmen       NA        3      0      1   <NA>    yum 0
4  Dinah        6        5      4      4  gross   <NA> 4
5 Billie       NA       NA     NA      2   <NA>  gross 2

[[3]]
    name cheese.1 cheese.2 milk.1 milk.2 tofu.1 tofu.2     v
1  Sarah        1        1     NA      1    yum  gross   yum
2   Ella        4        4      2      2    yum    yum   yum
3 Carmen       NA        3      0      1   <NA>    yum   yum
4  Dinah        6        5      4      4  gross   <NA> gross
5 Billie       NA       NA     NA      2   <NA>  gross gross
 

Проблемы с этой попыткой:

  1. новые столбцы неправильно названы (они должны быть названы cheese , milk а tofu не вызываться все v ).
  2. новые столбцы не добавляются в исходный фрейм данных. Я хочу, чтобы программа добавила ряд новых «основных» столбцов в мой фрейм данных (по одному новому столбцу для каждой пары столбцов, определенных в col.list ).

Комментарии:

1. Меня интересует решение coalesce , которое я не мог использовать с «динамическими» именами столбцов. Может быть, кто-нибудь, читающий это, мог бы дать какие-то идеи?

2. @Martin Gal, пожалуйста, взгляните на мое решение. Это не с динамическими именами столбцов, но, по крайней мере, с coalesce .

3. @MartinGal Я добавил опцию с помощью exec and coalesce . Он имеет динамические имена, но только с помощью str_glue() .

Ответ №1:

(1) Вы должны обернуть v в оператор curly-curly и использовать := :

 library(dplyr)

col.list <- c("cheese","milk","tofu")

lapply(col.list, FUN = function(x) {
  v <- as.name({{x}})
  v.1 <- as.name(paste0({{x}}, ".1"))
  v.2 <- as.name(paste0(({{x}}), ".2"))
  mydata %>% mutate({{ v }} = ifelse(is.na({{v.1}}), {{v.2}}, {{v.1}}))
})
 

ВОЗВРАТ

 [[1]]
    name cheese.1 cheese.2 milk.1 milk.2 tofu.1 tofu.2 cheese
1  Sarah        1        1     NA      1    yum  gross      1
2   Ella        4        4      2      2    yum    yum      4
3 Carmen       NA        3      0      1   <NA>    yum      3
4  Dinah        6        5      4      4  gross   <NA>      6
5 Billie       NA       NA     NA      2   <NA>  gross     NA

[...]
 

что на один шаг ближе к желаемому результату.

(2) Но для получения желаемого результата я предлагаю использовать purrr :

 library(purrr)
library(dplyr)

col.list %>% 
  map(~mydata %>% 
        select(name, starts_with(.x)) %>% 
        mutate({{ .x }} := ifelse(
          is.na(!!sym(paste0(.x, ".1"))), 
          !!sym(paste0(.x, ".2")), 
          !!sym(paste0(.x, ".1"))
          )
        )
  ) %>% 
  reduce(left_join, by = "name")
 

Это возвращает

     name cheese.1 cheese.2 cheese milk.1 milk.2 milk tofu.1 tofu.2  tofu
1  Sarah        1        1      1     NA      1    1    yum  gross   yum
2   Ella        4        4      4      2      2    2    yum    yum   yum
3 Carmen       NA        3      3      0      1    0   <NA>    yum   yum
4  Dinah        6        5      6      4      4    4  gross   <NA> gross
5 Billie       NA       NA     NA     NA      2    2   <NA>  gross gross
 

Комментарии:

1. Отличный ответ. Я попытался найти ответ на rlang, но в конце концов сдался.

2. @GuedesBF Ваш ответ намного элегантнее и (я думаю) быстрее.

3. Как всегда, мой друг, готов принять вызов 🙂

4. У меня есть только одно предложение, потому что давным-давно Анил сказал мне, и с тех пор я пробовал его. Я бы всегда предпочел не жестко кодировать решение, потому что мы не знаем, многие из них могут быть в реальном наборе данных.

Ответ №2:

Вот довольно простой и динамичный вариант. Поскольку он использует tidyselect, если имеется более двух столбцов (например cheese.1 , cheese.2 , и cheese.3 ), это все равно будет работать. Это также будет работать, если группы столбцов несбалансированы (например, 3 столбца с сыром, но только 2 столбца с молоком):

 library(purrr)
library(stringr)
library(rlang)
library(dplyr)

col.list <- c("cheese","milk","tofu")

express <- map(set_names(col.list), ~ 
                 str_glue("coalesce(!!!across(starts_with("{.x}")))") %>% 
                 parse_expr())

mydata %>%
  mutate(!!! express, .keep = "unused")
 

Вывод

Другие столбцы были удалены .keep = "unused" . Если вы хотите сохранить все столбцы, удалите этот аргумент.

     name cheese milk  tofu
1  Sarah      1    1   yum
2   Ella      4    2   yum
3 Carmen      3    0   yum
4  Dinah      6    4 gross
5 Billie     NA    2 gross
 

Как это работает

  1. Использование map и set_names важно, потому что это создает именованный список, который важен для оператора большого взрыва !!! позже. map создает именованный список выражений.
  2. across Использование и позволяет динамический выбор столбцов. coalesce
  3. !!! Оператор принудительно объединяет список объектов, а имена столбцов взяты из списка имен, настроенных с помощью map и set_names .

Комментарии:

1. Мне нравится использовать glue package здесь 🙂

Ответ №3:

Вот еще один способ сделать это среди всех замечательных ответов, которые вы получили:

 library(dplyr)
library(purrr)

col.list %>%
  reduce(~ .x %>% 
           bind_cols(mydata %>% 
                       select(starts_with(.y)) %>%
                       mutate(!!gsub("(\D )\.\d ", "\1", .y) := invoke(coalesce, cur_data()))), 
         .init = NULL)

  cheese.1 cheese.2 cheese milk.1 milk.2 milk tofu.1 tofu.2  tofu
1        1        1      1     NA      1    1    yum  gross   yum
2        4        4      4      2      2    2    yum    yum   yum
3       NA        3      3      0      1    0   <NA>    yum   yum
4        6        5      6      4      4    4  gross   <NA> gross
5       NA       NA     NA     NA      2    2   <NA>  gross gross
 

Комментарии:

1. Я подумал, := и !! экспортируются из rlang into dplyr . 😉

2. Да, Мартин, ты прав. Я отредактирую описание 🙂

3. К вашему сведению, invoke мягко амортизируется в пользу exec .

4. @LMc Да, точно, я прошел здесь немного старую школу 🙂 Спасибо за поддержку, я уже поддержал твою.

Ответ №4:

Вот один из способов, которым я бы это сделал. Сначала преобразовать в длинный формат, затем преобразовать обратно в широкий формат, но имеющий только 2 столбца значений 1 и 2

 library(dplyr)
library(tidyr)

mydata <- data.frame(name = c("Sarah","Ella","Carmen","Dinah","Billie"),
                     cheese.1 = c(1,4,NA,6,NA),
                     cheese.2 = c(1,4,3,5,NA),
                     milk.1 = c(NA,2,0,4,NA),
                     milk.2 = c(1,2,1,4,2),
                     tofu.1 = c("yum","yum",NA,"gross", NA),
                     tofu.2 = c("gross", "yum", "yum", NA, "gross"))
mydata_long <- mydata %>% 
  mutate(across(where(is.numeric), as.character)) %>% 
  pivot_longer(-name,
               names_to = c("food", "nr"),
               names_sep = "\.")
mydata_long
#> # A tibble: 30 x 4
#>    name  food   nr    value
#>    <chr> <chr>  <chr> <chr>
#>  1 Sarah cheese 1     1    
#>  2 Sarah cheese 2     1    
#>  3 Sarah milk   1     <NA> 
#>  4 Sarah milk   2     1    
#>  5 Sarah tofu   1     yum  
#>  6 Sarah tofu   2     gross
#>  7 Ella  cheese 1     4    
#>  8 Ella  cheese 2     4    
#>  9 Ella  milk   1     2    
#> 10 Ella  milk   2     2    
#> # ... with 20 more rows
 

Применить ifelse() функцию после преобразования обратно в другой широкий формат

 mydata_wide <- mydata_long %>% 
  pivot_wider(names_from = nr,
              values_from = value) %>% 
  mutate(final_val = ifelse(is.na(`1`), `2`, `1`)) %>% 
  arrange(food)
mydata_wide
#> # A tibble: 15 x 5
#>    name   food   `1`   `2`   final_val
#>    <chr>  <chr>  <chr> <chr> <chr>    
#>  1 Sarah  cheese 1     1     1        
#>  2 Ella   cheese 4     4     4        
#>  3 Carmen cheese <NA>  3     3        
#>  4 Dinah  cheese 6     5     6        
#>  5 Billie cheese <NA>  <NA>  <NA>     
#>  6 Sarah  milk   <NA>  1     1        
#>  7 Ella   milk   2     2     2        
#>  8 Carmen milk   0     1     0        
#>  9 Dinah  milk   4     4     4        
#> 10 Billie milk   <NA>  2     2        
#> 11 Sarah  tofu   yum   gross yum      
#> 12 Ella   tofu   yum   yum   yum      
#> 13 Carmen tofu   <NA>  yum   yum      
#> 14 Dinah  tofu   gross <NA>  gross    
#> 15 Billie tofu   <NA>  gross gross
 
 mydata_wide2 <- mydata_wide %>% 
  pivot_wider(-c(`1`, `2`),
              names_from = food,
              values_from = final_val) 
mydata_wide2
#> # A tibble: 5 x 4
#>   name   cheese milk  tofu 
#>   <chr>  <chr>  <chr> <chr>
#> 1 Sarah  1      1     yum  
#> 2 Ella   4      2     yum  
#> 3 Carmen 3      0     yum  
#> 4 Dinah  6      4     gross
#> 5 Billie <NA>   2     gross
 

Создано 2021-10-29 пакетом reprex (v2.0.1)

Ответ №5:

Я бы использовал purrr::map_dfc и coalesce здесь. Выглядит довольно просто.

 library(purrr)
library(dplyr)
library(stringr)

mydata %>% mutate(map2_dfc(select(., ends_with('1')),
                           select(., ends_with('2')),
                           ~coalesce(.x, .y)))%>%
  select(-ends_with('2'))%>%
  rename_with(~str_remove(.x, '\.\d 


Комментарии:

1. Отличный ответ, мой друг :)

Ответ №6:

Вот как вы можете выполнить свою задачу:

  1. определите свои пары (в случае, если у вас сотни столбцов, это можно автоматизировать.
  2. использовать imap_dfc для применения coalesce определенных пар
  3. привязка к исходному фрейму данных
 library(dplyr)
library(purrr)

pairs <- list(cheese = c(2, 3), milk = c(4, 5), tofu = c(6, 7))

imap_dfc(pairs, ~mydata[, .x] %>% transmute(!!.y := coalesce(!!!syms(names(mydata)[.x])))) %>% 
  bind_cols(mydata)
 
   cheese milk  tofu   name cheese.1 cheese.2 milk.1 milk.2 tofu.1 tofu.2
1      1    1   yum  Sarah        1        1     NA      1    yum  gross
2      4    2   yum   Ella        4        4      2      2    yum    yum
3      3    0   yum Carmen       NA        3      0      1   <NA>    yum
4      6    4 gross  Dinah        6        5      4      4  gross   <NA>
5     NA    2 gross Billie       NA       NA     NA      2   <NA>  gross
 

Комментарии:

1. Есть много хороших способов решить эту проблему.

2. В этом случае ваш ответ будет лучшим. И я думаю, что Guedes уже ответил. Так что на этот раз вы можете расслабиться и наслаждаться!

3. Это тоже здорово, мой друг 🙂

Ответ №7:

Еще один вариант tidyverse. Преимущество здесь в том, что он сохраняет исходный тип данных и не преобразует все в символьные значения.

 library(tidyverse)
mydata %>%
  pivot_longer(cols = -name,
               names_pattern = '(.*)(\..)',
               names_to = c('.value', 'number')) %>%
  group_by(name) %>%
  mutate(across(-number, ~if_else(is.na(.[1]), .[2], .[1]))) %>%
  ungroup() %>%
  filter(number == '.1') %>%
  select(-number)
 

Что дает

 # A tibble: 5 x 4
  name   cheese  milk tofu 
  <chr>   <dbl> <dbl> <chr>
1 Sarah       1     1 yum  
2 Ella        4     2 yum  
3 Carmen      3     0 yum  
4 Dinah       6     4 gross
5 Billie     NA     2 gross
 

Альтернативное решение с coalesce :

 mydata %>%
  pivot_longer(cols = -name,
               names_pattern = '(.*)(\..)',
               names_to = c('.value', 'number')) %>%
  group_by(name) %>%
  mutate(across(-number, ~coalesce(.[1], .[2]))) %>%
  ungroup() %>%
  filter(number == '.1') %>%
  select(-number)
 

Комментарии:

1. Да, сначала я подумал о чем-то подобном, но хотел использовать несколько динамических столбцов в функции объединения. Я думаю, @GuedesBF показал правильное решение для этого. 🙂

))

name cheese milk tofu
1 Sarah 1 1 yum
2 Ella 4 2 yum
3 Carmen 3 0 yum
4 Dinah 6 4 gross
5 Billie NA 2 gross

Комментарии:

1. Отличный ответ, мой друг 🙂

Ответ №6:

Вот как вы можете выполнить свою задачу:

  1. определите свои пары (в случае, если у вас сотни столбцов, это можно автоматизировать.
  2. использовать imap_dfc для применения coalesce определенных пар
  3. привязка к исходному фрейму данных


Комментарии:

1. Есть много хороших способов решить эту проблему.

2. В этом случае ваш ответ будет лучшим. И я думаю, что Guedes уже ответил. Так что на этот раз вы можете расслабиться и наслаждаться!

3. Это тоже здорово, мой друг 🙂

Ответ №7:

Еще один вариант tidyverse. Преимущество здесь в том, что он сохраняет исходный тип данных и не преобразует все в символьные значения.


Что дает


Альтернативное решение с coalesce :


Комментарии:

1. Да, сначала я подумал о чем-то подобном, но хотел использовать несколько динамических столбцов в функции объединения. Я думаю, @GuedesBF показал правильное решение для этого. 🙂