You need to enable JavaScript to run this app.
优惠活动
大模型
产品
解决方案
定价
更多

如何用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

相关产品推荐
方舟 Agent Plan

超全模态模型 × Harness 升级,最新支持 Deepseek-V4.1-Flash、GLM-5.3 系列、Doubao-Seedream-5.0-pro、Kimi-K3 (部分), 限时 9.9 元起

最近更新时间:2026.07.15 15:24:54