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

Question

I have the following dataframe:
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)
I want to apply the following function to date1 through date4 columns:
mad <- function(x, y) abs(mean(x - y, na.rm = TRUE))
However, I want to retain the "name" identifier.
I have asked a similar question in the past and the solution worked. However, when attempting to adapt the code, I'm running into issues.
Here's what I thought should work, based on the previous post.
apply(date_data[, 3:6], function(x) mad(date_data[,7], x))
In other words, I'm attempting to find the mean absolute difference (the custom function, "mad") between column 7 ("date5") and columns 3 through 5 (i.e. "date1" through "date4") for each group. The goal is to have a new dataframe that gives the mean absolute difference for each of the date columns (1-4) with two rows, one for groupA and one for groupB.
I tried mapping the function, but I get an error that "arguments imply differeng number of rows."
Here's the code for the map() that does not work:
date_data_test <- date_data %>%
group_by(name) %>%
map_at(c(3:6), function(x) mad(date_data[,7], x)) %>%
data.frame()
Any suggestions are appreciated. Thank you.

Answer 1

Using the across function from 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
Created on 2021-11-11 by the reprex package (v2.0.1)