如何用dplyr的summarize函数为指定列匹配对应聚合函数
我正在编写一个将短时间间隔数据聚合(上卷)为长时间间隔数据的函数,目前使用dplyr和lubridate实现。
函数的输入数据框包含一个时间列和一个或多个自变量列。我希望用户能够指定用于聚合数据的函数,这是函数的variable_aggregation参数,它是一个函数向量,例如c(sum, median, mean, sd)。函数的数量应与输入数据框中的自变量列数量匹配,且顺序对应要应用函数的列顺序。
预期效果是每个函数仅应用于对应顺序的列。例如,若有四个自变量列Ozone、Solar.R、Wind和Temp,函数列表c(sum, median, mean, sd)会将Ozone按sum聚合,Solar.R按median聚合,Wind按mean聚合,Temp按标准差聚合。
这里出现了问题:当dplyr的summarize函数传入变量列表和函数列表时,会将每个函数应用于所有列,导致输出列数平方增长。以上述例子来说,sum、median、mean和sd都会应用于4列,最终生成16列。
尝试的解决方案
目前我只能先保留所有列再删除多余列,但该函数将用于超大型数据集(多年的分钟级间隔数据),且可能包含大量自变量列,我担心这些不必要的计算会影响性能。
以下是我当前代码的简单示例:
aggregate_func <- function (independent_variables, variable_aggregation){ variable_names <- colnames(independent_variables[, -1]) hourly_independent_variables <- independent_variables %>% dplyr::mutate(hour = lubridate::floor_date(time, "hour")) %>% dplyr::group_by("time" = hour) %>% dplyr::summarize_at(.vars = variable_names, .funs = variable_aggregation, na.rm = T) # 设置列名并删除summarize函数生成的多余列 variable_aggregation_indices <- seq(from = 2, to = length(variable_names)^2 + 1, by = length(variable_names) + 1) names(hourly_independent_variables)[variable_aggregation_indices] <- variable_names hourly_independent_variables <- hourly_independent_variables[, c("time", variable_names)] return(hourly_independent_variables) }
我知道也可以结合summarize和across实现,但仍存在生成过多列的问题,而且across函数已弃用单独指定na.rm = T的方式,这一点对我很重要。
hourly_independent_variables <- independent_variables %>% dplyr::mutate(hour = lubridate::floor_date(time, "hour")) %>% dplyr::group_by("time" = hour) %>% dplyr::summarize(dplyr::across(.cols = dplyr::all_of(variable_names), .fns = variable_aggregation))
可复现输入
以下是用于测试的输入和可复现代码,我使用了R内置数据集"airquality":
library(dplyr) library(lubridate) ind_vars <- force(airquality) time_series <- seq.POSIXt(from = lubridate::ymd_hms("2023-01-01 00:00:00", tz = "UTC"), to = lubridate::ymd_hms("2023-01-02 14:00:00", tz = "UTC"), by = lubridate::as.duration("15 mins"), tz = "UTC") ind_vars <- ind_vars %>% dplyr::mutate(time = time_series, .before = Ozone) %>% dplyr::select(-c("Month", "Day")) agg_funcs <- c(sum, median, mean, sd) hourly_vars <- aggregate_func(ind_vars, agg_funcs)
输入数据的前10行如下:
time Ozone Solar.R Wind Temp 1 2023-01-01 00:00:00 41 190 7.4 67 2 2023-01-01 00:15:00 36 118 8.0 72 3 2023-01-01 00:30:00 12 149 12.6 74 4 2023-01-01 00:45:00 18 313 11.5 62 5 2023-01-01 01:00:00 NA NA 14.3 56 6 2023-01-01 01:15:00 28 NA 14.9 66 7 2023-01-01 01:30:00 23 299 8.6 65 8 2023-01-01 01:45:00 19 99 13.8 59 9 2023-01-01 02:00:00 8 19 20.1 61 10 2023-01-01 02:15:00 NA 194 8.6 69
输出数据的前10行应如下所示:
time Ozone Solar.R Wind Temp <dttm> <int> <dbl> <dbl> <dbl> 1 2023-01-01 00:00:00 107 170. 9.88 5.38 2 2023-01-01 01:00:00 70 199 12.9 4.80 3 2023-01-01 02:00:00 31 194 11.3 5.38 4 2023-01-01 03:00:00 57 282 11.2 4.32 5 2023-01-01 04:00:00 81 192. 12.9 4.86 6 2023-01-01 05:00:00 48 58.5 12 6.40 7 2023-01-01 06:00:00 23 66 12.9 4.86 8 2023-01-01 07:00:00 197 266. 9.15 2.08 9 2023-01-01 08:00:00 0 231 10.9 8.58 10 2023-01-01 09:00:00 100 268. 11.2 4.93
任何建议都将不胜感激,我试图避免使用for循环以保持代码简洁易读。
感谢用户提供的使用purrr包中map2封装summarize调用的解决方案。以下是我基于该框架实现的最终函数,我选择使用summarize_at而非summarize和across,因为across函数已弃用单独指定na.rm = TRUE的方式。
aggregate_func <- function (independent_variables, variable_aggregation){ variable_names <- colnames(independent_variables[, -1]) hourly_independent_variables <- map2(.x = variable_names, .y = variable_aggregation, .f = ~independent_variables %>% dplyr::mutate(hour = lubridate::floor_date(time, "hour")) %>% dplyr::group_by("time" = hour) %>% dplyr::summarize_at(.vars = .x, .funs = .y, na.rm = T)) %>% reduce(left_join, by = 'time') return(hourly_independent_variables) }
内容的提问来源于stack exchange,提问作者Kyle Wolfe

