在 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

使用 dplyr 中的 across 函数：

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 package (v2.0.1)}

于 2021-11-11 创建

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

apply a custom function across certain columns in a dataframe in R

r

apply