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

【问题标题】：apply a custom function across certain columns in a dataframe in R在 R 中的数据框中的某些列上应用自定义函数
【发布时间】：2021-12-23 13:07:49
【问题描述】：

我有以下数据框：

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))

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

我过去曾问过similar question，解决方案奏效了。但是，在尝试调整代码时，我遇到了问题。

这是我认为应该起作用的方法，基于previous post。

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()

感谢任何建议。谢谢。

【问题讨论】：

(1) apply 有一个强制性的第二个参数 MARGIN=，您错误地分配了一个函数（或忽略了该参数）。 (2) 你在这里的使用更适合lapply(date_data[,3:6], function(x) ...)，因为它自然会返回一个list，它比矩阵更兼容data.frame（或list，非确定性 i>!!) 由apply 返回。
最终，如果您想用标准化数据替换列3:6，那么date_data[,3:6] <- lapply(date_data[,3:6], function(x) ...) 会这样做。
谢谢@r2evans。这就解释了为什么以前的代码不起作用。但是，尝试将该代码应用于我的实际数据集是行不通的。我认为我在这里提供的数据并不能提供全部情况。我已更新问题以更好地反映真实情况。

标签： r apply

【解决方案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 日创建}

【讨论】：