Question

我正在寻找在R中的任意数据组中的任意行的子集中应用任意函数的一般方法。

以下是我编写的函数示例，其中组数据然后在给定组的行的子集（窗口）中应用任意函数，例如sum或mean。

#' @param DATA data frame. This is the data set containing the data to be grouped, 
#' ordered, and used in the calculation.
#' @param GROUP_BY character vector. This is a vector of the columns of the data 
#' frame that are to be used to group different observations which are then 
#' FUNCTIONed across. 
#' @param ORDER_BY character. This is the name of the column of DATA that is 
#' to be used for determining the WINDOW.
#' @param CALC_OVER character. The name of the column over which the calculation is 
#' to be performed in accordance with FUNCTION.
#' @param WINDOW integer. Positive integer will sum the WINDOW values of CALC_OVER 
#' on and after each ORDER_BY. Negative integer will sum the WINDOW values of CALC_OVER 
#' values on and before each ORDER_BY.
#' @param FUNCTION character. Name of function to be used on values defined by 
#' CALC_OVER over the WINDOW.
#' FUNCTION applied to the CALC_OVER data.
#' @export

ApplyFunctionWindow <- function(DATA, GROUP_BY, ORDER_BY,  CALC_OVER, 
                                WINDOW = -4L, FUNCTION) {             
  # dplyr's arrange, order_by, and mutate would probably be faster but are a pain 
    # to implement with dynamic variables
  if (length(GROUP_BY) > 1) {
    grouped_data <- split(x = DATA, f = as.list(DATA[, GROUP_BY]), drop = TRUE)
  } else {
    grouped_data <- split(x = DATA, f = DATA[, GROUP_BY], drop = TRUE)
  }

  calculations <- dplyr::data_frame()

  for (g in 1:length(grouped_data)) {
    grouped_data_frame <- grouped_data[[g]]

    for (r in 1:nrow(grouped_data_frame)) {
      grouped_data_frame <- grouped_data_frame[ 
        order(grouped_data_frame[, ORDER_BY]), 
        ]

      if( WINDOW < 0) {
        if( (r + 1 + WINDOW) < 1L | (r + 1 + WINDOW) > nrow(grouped_data_frame)) {
          grouped_data_frame[r, paste(CALC_OVER, FUNCTION, WINDOW, sep = "_")] <- NA
        } else {
          grouped_data_frame[r, paste(CALC_OVER, FUNCTION, WINDOW, sep = "_")] <- 
            do.call(what = FUNCTION, 
                    args = list(grouped_data_frame[r:(r + 1 + WINDOW), CALC_OVER]))
        }
      } else {
        if((r - 1 + WINDOW) > nrow(grouped_data_frame)) {
          grouped_data_frame[r, paste(CALC_OVER, FUNCTION, WINDOW, sep = "_")] <- NA
        } else {
          grouped_data_frame[r, paste(CALC_OVER, FUNCTION, WINDOW, sep = "_")] <- 
            do.call(what = FUNCTION, 
                    args = list(grouped_data_frame[r:(r - 1 + WINDOW), CALC_OVER]))
        }
      }
    }

      calculations <- dplyr::bind_rows(calculations, grouped_data_frame)
    } else {
      calculations <- dplyr::bind_rows(calculations, grouped_data_frame)
    }

  }

  calculations
}

以下是示例数据集以及我的函数的输出。它按预期工作，并且可以快速处理小型数据集。但是，我经常拥有数百万行的数据集，其中包含10到20,000个不同的组。

example_data <- data.frame(id_1 = c(rep("jane", 8), rep("joe", 12), rep("jack", 16)), 
                  id_2 = c(rep("doe", 8), rep("doe", 12), rep("smith", 16)),
                  year = c(rep(2010, 4), rep(2011, 4), 
                           rep(2008, 4), rep(2009, 4), rep(2010, 4), 
                           rep(2005, 4), rep(2006, 4), rep(2007, 4), rep(2008, 4)), 
                  quarter = rep(seq(1:4), 9),
           data_value = rnorm(36, 10, 1),
           stringsAsFactors = FALSE
                  )

example_data[, "year_quarter"] <- paste(example_data[, "year"], 
                                        "_",
                                        example_data[, "quarter"])

trailing_four_quarters <- ApplyFunctionWindow(DATA = example_data, 
                                              GROUP_BY = c("id_1", "id_2"), 
                                              ORDER_BY = "year_quarter", 
                                              CALC_OVER = "data_value", 
                                              WINDOW = -4L, 
                                              FUNCTION = "sum", 
                                              OMIT_NA = FALSE)

Answer 1

申请不是r完成任务的唯一方法 - 使用data.table

可以做得更好

library(data.table)
setDT(example_data)

cols <- c("data_value")
cols_L4Q <- paste0(cols,"_L4Q")

example_data <- example_data[order(id_1,id_2,year,quarter)]

example_data[, (cols_L4Q) := lapply(.SD, function(x) { Reduce(`+`, shift(x, 0L:(4 - 1L), type = "lag")) }), .SDcols = cols, by = .(id_1,id_2)]

这适用于多个列，只需相应地构建cols。

`+`可以是聚合向量的任何函数（包括mean，sum等）。如果您不需要尾随行为，则可以删除移位功能。

Answer 2

我还没有检查过你的所有代码，但按组生成滚动总和可以像这样紧凑地实现。我们首先定义要应用的函数，然后使用ave按组运行它：

library(zoo)

roll <- function(x) if (length(x) >= 4) rollsumr(x, 4, fill = NA) else NA
transform(example_data, four_quarters = ave(data_value, id_1, id_2, FUN = roll))

在R中的组内的行的子集之间分组然后应用函数的有效方法

2 个答案: