在 R 中的数据框中的某些列上应用自定义函数

Question

我有以下数据框：

library(tidyverse)
library(lubridate)

date_data1 <- data.frame(
  name = c('groupA'),
  number = as.numeric(c(1:10)),
  date1 = seq(from = ymd('2019-07-01'), to = ymd('2019-07-10'), by='days'), 
  date2 = seq(from = ymd('2019-07-02'), to = ymd('2019-07-11'), by='days'),
  date3 = seq(from = ymd('2019-06-29'), to = ymd('2019-07-08'), by='days'),
  date4 = seq(from = ymd('2019-07-03'), to = ymd('2019-07-12'), by='days'),
  date5 = seq(from = ymd('2019-07-05'), to = ymd('2019-07-14'), by='days')
) %>%
  mutate(yday = yday(date5))

date_data2 <- data.frame(
  name = c('groupB'),
  number = as.numeric(c(1:10)),
  date1 = seq(from = ymd('2019-07-01'), to = ymd('2019-07-10'), by='days'), 
  date2 = seq(from = ymd('2019-07-02'), to = ymd('2019-07-11'), by='days'),
  date3 = seq(from = ymd('2019-06-29'), to = ymd('2019-07-08'), by='days'),
  date4 = seq(from = ymd('2019-07-03'), to = ymd('2019-07-12'), by='days'),
  date5 = seq(from = ymd('2019-07-05'), to = ymd('2019-07-14'), by='days')
) %>%
  mutate(yday = yday(date5))

date_data <- bind_rows(date_data1, date_data2)

我想将以下函数应用于 date1 到 date4 列：

mad <- function(x, y) abs(mean(x - y, na.rm = TRUE))

但是，我想保留“名称”标识符。

我过去问过一个类似的问题，解决方案奏效了。 但是，在尝试调整代码时，我遇到了问题。

根据上一篇文章，这是我认为应该可行的方法。

apply(date_data[, 3:6], function(x) mad(date_data[,7], x))

换句话说，我试图找到每个组的第 7 列（“date5”）和第 3 到第 5 列（即“date1”到“date4”）之间的平均绝对差（自定义函数，“mad”）。 目标是拥有一个新数据框，该数据框为每个日期列 (1-4) 提供两行的平均绝对差值，其中一行用于 groupA，另一行用于 groupB。

我尝试映射该函数，但出现“参数意味着不同的行数”的错误。

这是不起作用的 map() 的代码：

date_data_test <- date_data %>%
  group_by(name) %>%
  map_at(c(3:6), function(x) mad(date_data[,7], x)) %>%
  data.frame()

任何建议表示赞赏。 谢谢你。

Answer 1

使用across从dplyr功能：

library(tidyverse)
library(lubridate)
#> 
#> Attaching package: 'lubridate'
#> The following objects are masked from 'package:base':
#> 
#>     date, intersect, setdiff, union

date_data1 <- data.frame(
  name = c('groupA'),
  number = as.numeric(c(1:10)),
  date1 = seq(from = ymd('2019-07-01'), to = ymd('2019-07-10'), by='days'), 
  date2 = seq(from = ymd('2019-07-02'), to = ymd('2019-07-11'), by='days'),
  date3 = seq(from = ymd('2019-06-29'), to = ymd('2019-07-08'), by='days'),
  date4 = seq(from = ymd('2019-07-03'), to = ymd('2019-07-12'), by='days'),
  date5 = seq(from = ymd('2019-07-05'), to = ymd('2019-07-14'), by='days')
) %>%
  mutate(yday = yday(date5))

date_data2 <- data.frame(
  name = c('groupB'),
  number = as.numeric(c(1:10)),
  date1 = seq(from = ymd('2019-07-01'), to = ymd('2019-07-10'), by='days'), 
  date2 = seq(from = ymd('2019-07-02'), to = ymd('2019-07-11'), by='days'),
  date3 = seq(from = ymd('2019-06-29'), to = ymd('2019-07-08'), by='days'),
  date4 = seq(from = ymd('2019-07-03'), to = ymd('2019-07-12'), by='days'),
  date5 = seq(from = ymd('2019-07-05'), to = ymd('2019-07-14'), by='days')
) %>%
  mutate(yday = yday(date5))

date_data <- bind_rows(date_data1, date_data2) %>% 
  as_tibble()

date_data %>%
  group_by(name) %>%
  summarise(across(
    .cols = 2:5,
    .fns = ~ abs(mean(interval(.x, date5) %/% days(1))),
    .names = "diff_{.col}_date5"
  ))
#> # A tibble: 2 × 5
#>   name   diff_date1_date5 diff_date2_date5 diff_date3_date5 diff_date4_date5
#>   <chr>             <dbl>            <dbl>            <dbl>            <dbl>
#> 1 groupA                4                3                6                2
#> 2 groupB                4                3                6                2

^{由reprex 包(v2.0.1) 于 2021 年 11 月 11 日创建}