Как использовать функцию в mutate с несколькими входами в конвейер

Question

Как применить мою функцию в конвейере.

Это мой ДФ

library(tidyverse)
library(lubridate)

status  <- c("exit", "start", "start", "exit", "start", "exit", "exit", "suspended", "start")
active_date <- c("1/05/2018", "11/10/2017", "1/05/2018", "1/07/2018", "1/07/2018", "27/09/2018", "27/09/2018", "27/09/2018", "25/10/2018")
start_date <- c("11/10/2017", "11/10/2017", "1/05/2018", "1/05/2018", "1/07/2018", "1/07/2018", "1/07/2018", "27/09/2018", "27/09/2018")
exit_date <- c("1/05/2018", NA, NA, "1/07/2018", NA, "27/09/2018", "27/09/2018", NA, NA)
suspend_start_date <- c(NA, NA, NA, NA, NA, "27/09/2018", "27/09/2018", "27/09/2018", "27/09/2018")
suspend_end_date <- c(NA, NA, NA, NA, NA, NA, "25/10/2018", NA, "25/10/2018")


df <- cbind(status, start_date, exit_date,  suspend_start_date, suspend_end_date) %>%
  as_tibble %>% mutate_at(2:5, .funs = dmy)

Это моя функция

find_active_date <- function(x = status,
                             exit_date, 
                             suspend_start_date,
                             suspend_end_date,
                             start_date){
  case_when(x == "exit" ~ exit_date,
            x == "suspended" ~ suspend_start_date,
            x == "start" & !is.na(suspend_end_date) ~ suspend_end_date,
            TRUE ~ start_date)  

}

Функция работает, когда я вставляю один элемент ввода за раз, например, так:

find_active_date(df$status[1],
                 df$exit_date[1],
                 df$suspend_start_date[1],
                 df$suspend_end_date[1],
                 df$start_date[1])

Это желаемый вывод

output_df <- cbind(df, active_date) %>% 
              as_tibble %>% 
              mutate(active_date = dmy(active_date))

Это то, что я пробовал, который не работает

df %>%
  rowwise %>%
  mutate(active_date = find_active_date(status, 
                                        suspend_start_date, 
                                        suspend_end_date, 
                                        start_date))

Answer 1

Мы можем использовать pmap с reduce, и он не будет выполнять какое-либо принудительное / реконверсионное

library(tidyerse)
df$active_date <- pmap(df, find_active_date) %>%
                          reduce(c)
df
# A tibble: 9 x 6
#  status    start_date exit_date  suspend_start_date suspend_end_date active_date
#  <chr>     <date>     <date>     <date>             <date>           <date>     
#1 exit      2017-10-11 2018-05-01 NA                 NA               2018-05-01 
#2 start     2017-10-11 NA         NA                 NA               2017-10-11 
#3 start     2018-05-01 NA         NA                 NA               2018-05-01 
#4 exit      2018-05-01 2018-07-01 NA                 NA               2018-07-01 
#5 start     2018-07-01 NA         NA                 NA               2018-07-01 
#6 exit      2018-07-01 2018-09-27 2018-09-27         NA               2018-09-27 
#7 exit      2018-07-01 2018-09-27 2018-09-27         2018-10-25       2018-09-27 
#8 suspended 2018-09-27 NA         2018-09-27         NA               2018-09-27 
#9 start     2018-09-27 NA         2018-09-27         2018-10-25       2018-10-25 

---

Или используя base R с Map

do.call(c, do.call(Map, c(f = find_active_date, df)))

ПРИМЕЧАНИЕ. В функции один из параметров называется «x».Таким образом, столбец «status» также должен соответствовать этому имени параметра.

ПРИМЕЧАНИЕ2: Оба решения не требуют какого-либо принуждения к классу Date впоследствии.

Answer 2

Ваши rowwise решения работают, но вы упустили exit_date

library(dplyr)

df %>%
  rowwise %>%
  mutate(active_date = find_active_date(status, 
                                        exit_date,
                                        suspend_start_date, 
                                        suspend_end_date, 
                                        start_date))


# A tibble: 9 x 6
#  status    start_date exit_date  suspend_start_date suspend_end_date active_date
#  <chr>     <date>     <date>     <date>             <date>           <date>     
#1 exit      2017-10-11 2018-05-01 NA                 NA               2018-05-01 
#2 start     2017-10-11 NA         NA                 NA               2017-10-11 
#3 start     2018-05-01 NA         NA                 NA               2018-05-01 
#4 exit      2018-05-01 2018-07-01 NA                 NA               2018-07-01 
#5 start     2018-07-01 NA         NA                 NA               2018-07-01 
#6 exit      2018-07-01 2018-09-27 2018-09-27         NA               2018-09-27 
#7 exit      2018-07-01 2018-09-27 2018-09-27         2018-10-25       2018-09-27 
#8 suspended 2018-09-27 NA         2018-09-27         NA               2018-09-27 
#9 start     2018-09-27 NA         2018-09-27         2018-10-25       2018-10-25 

---

Другой вариант - использовать pmap_dbl из purrr, который возвращает дату в виде числового значения, которое вы можете изменитьпозже с as.Date.

library(dplyr)
library(purrr)

df %>%
  mutate(active_date = pmap_dbl(list(status, exit_date, suspend_start_date, 
                       suspend_end_date, start_date), find_active_date), 
         active_date = as.Date(active_date, origin = "1970-01-01"))