使用 purrr 帮助转换大型数据文件

Question

我有一些代码遍历许多包含日期的列，并从选项中选择最早的日期来填充新列。为此，我使用了 dplyr::rowwise 函数。

不幸的是，数据集很大，获取输出需要时间。这是我最初方法的一个例子。

library(tidyverse)
library(lubridate)

set.seed(101)

data <- tibble(date1 = sample(
  seq(ymd('2021-03-20'), ymd('2021-05-20'), by = 'day'), 
  100, replace = TRUE),
  date2 = sample(seq(ymd('2021-03-20'), ymd('2021-05-20'), by = 'day'), 
    100, replace = TRUE),
  date3 = sample(seq(ymd('2021-03-20'), ymd('2021-05-20'), by = 'day'), 
    100, replace = TRUE),
  date4 = sample(seq(ymd('2021-03-20'), ymd('2021-05-20'), by = 'day'), 
    100, replace = TRUE),
  date5 = sample(seq(ymd('2021-03-20'), ymd('2021-05-20'), by = 'day'), 
    100, replace = TRUE))

所以第一次尝试我选择了rowwise。我以前没有用过这个，但输出被识别为 'rowwise_df'，如果我使用 group_by.

，我认为它是相似的

data <- data %>%
  rowwise() %>%
  mutate(earlierst_date = min(c(date1, date2, date3, date4, date5),
                              na.rm = TRUE))

环顾四周，看来 rowwise 并不是最好的方法 (see excellent back and forth here)。通过阅读，我尝试了以下...

data <- data %>%
  mutate(try_again = pmap(list(date1, date2, date3, date4, date5), 
                          min, na.rm = TRUE)) %>%
  mutate(try_again = as_date(try_again))

table(data$earlierst_date == data$try_again)
#> 
#> TRUE 
#>  100

根据我的 reprex 运行，第二个选项的速度是原来的两倍。

start.time <- Sys.time()
data <- data %>%
  rowwise() %>%
  mutate(earlierst_date = min(c(date1, date2, date3, date4, date5),
                              na.rm = TRUE))
end.time <- Sys.time()
time.taken <- end.time - start.time
time.taken
#> Time difference of 0.07597804 secs

start.time <- Sys.time()
data <- data %>%
  mutate(try_again = pmap(list(date1, date2, date3, date4, date5), 
                          min, na.rm = TRUE)) %>%
  mutate(try_again = as_date(try_again))
end.time <- Sys.time()
time.taken <- end.time - start.time
time.taken
#> Time difference of 0.03266287 secs

我的问题：

1. 使用 pmap 的第二种策略是否符合目的，还是存在一些我看不到的固有错误？例如，在早期的尝试中，输出列包含列表值而不是向量，这让我很吃惊。

每当我必须处理日期时，我都会感到头晕，尤其是当我读到诸如“日期是存储为自 1970 年 1 月 1 日以来的天数”之类的评论时...

2. 代码运行次有意义吗？

任何 improvements/direction 大受好评。

Answer 1

根据我的经验，rowwise 非常慢，所以我更喜欢使用任何其他选项（代价是代码不那么整洁），尤其是当我有数字列时（然后我转换为矩阵）。 pmap 绝对是选项，但有时我无法列出所有需要的列（没有整洁的 select 选项）。通过在 pmap:

中使用 select 可以稍微避免这种情况

data <- data %>%
  mutate(min_date = pmap_dbl(select(., matches("^date")), min) %>% as.Date(origin = "1970-01-01"))

转换为矩阵通常是解决我的问题的最快方法（快得多）（结合 apply 或 sweep:

等函数

data[["min_date"]] <- data %>% 
  mutate(across(where(is.Date), as.integer)) %>% 
  as.matrix() %>% 
  apply(1, function(x) x[which.min(x)]) %>%
  as.Date(origin = "1970-01-01")

Answer 2

我同意@det 的观点，rowwise 不是正确的选择。我认为 pmin 函数可能最适合该任务，例如

data <- transform(data, earliest_date = pmin(date1, date2, date3, date4, date5, na.rm = TRUE))

基准测试（已更新以包含 data.table 解决方案）：

library(tidyverse)
library(lubridate)

set.seed(101)

data <- tibble(date1 = sample(
  seq(ymd('2021-03-20'), ymd('2021-05-20'), by = 'day'), 
  100, replace = TRUE),
  date2 = sample(seq(ymd('2021-03-20'), ymd('2021-05-20'), by = 'day'), 
                 100, replace = TRUE),
  date3 = sample(seq(ymd('2021-03-20'), ymd('2021-05-20'), by = 'day'), 
                 100, replace = TRUE),
  date4 = sample(seq(ymd('2021-03-20'), ymd('2021-05-20'), by = 'day'), 
                 100, replace = TRUE),
  date5 = sample(seq(ymd('2021-03-20'), ymd('2021-05-20'), by = 'day'), 
                 100, replace = TRUE))

rowwise_func <- function(data){
  data %>%
    rowwise() %>%
    mutate(earliest_date = min(c(date1, date2, date3, date4, date5),
                               na.rm = TRUE)) %>% 
    ungroup()
}

pmap_func <- function(data){
  data %>% 
    mutate(try_again = pmap(list(date1, date2, date3, date4, date5), 
                          min, na.rm = TRUE))
  }

det_func1 <- function(data){
  data %>%
  mutate(min_date = pmap_dbl(select(., matches("^date")), min) %>% as.Date(origin = "1970-01-01"))
}

det_faster <- function(data){
  data[["min_date"]] <- data %>% 
    mutate(across(where(is.Date), as.integer)) %>% 
    as.matrix() %>% 
    apply(1, function(x) x[which.min(x)]) %>%
    as.Date(origin = "1970-01-01")
}

transform_func <- function(data){
  as_tibble(transform(data, earliest_date = pmin(date1, date2, date3, date4, date5, na.rm = TRUE)))
}

dt_func <- function(data){
  setDT(data)
  data[, earliest_date := pmin(date1, date2, date3, date4, date5, na.rm = TRUE)]
}

times <- microbenchmark::microbenchmark(rowwise_func(data), pmap_func(data), det_func1(data), det_faster(data), transform_func(data), dt_func(data))
autoplot(times)

data2 <- transform_func(data)
data3 <- rowwise_func(data)
identical(data2, data3)
#> TRUE

Unit: microseconds
                 expr      min        lq      mean    median        uq        max neval cld
   rowwise_func(data) 6764.693 6919.6720 7375.0418 7066.6220 7271.5850  16290.696   100  ab
      pmap_func(data) 3994.973 4150.1360 9425.3880 4252.9850 4437.2950 491030.248   100   b
      det_func1(data) 5576.240 5724.6820 6249.7573 5845.3305 5985.5940  15106.741   100  ab
     det_faster(data) 3182.016 3305.3525 3556.8628 3362.8720 3444.0505  12771.952   100  ab
 transform_func(data)  564.194  624.1055  697.5630  680.1130  718.7975   1513.184   100  a 
        dt_func(data)  650.611  723.7235  956.7916  759.3355  782.0565  10806.902   100  a

因此，根据我上面使用的函数，transform + pmin 方法比 rowwise 方法快约 10 倍。

使用 purrr 帮助转换大型数据文件

Using purrr to help transform a large data file

r

lubridate

dplyr

purrr