我有一些代码遍历许多包含日期的列,并从选项中选择最早的日期来填充新列。为此,我使用了 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-01-01 以来的天数”之类的评论时...
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 倍。
关于r - 使用 purrr 帮助转换大型数据文件,我们在Stack Overflow上找到一个类似的问题: https://stackoverflow.com/questions/67618008/