グループ内の行のサブセット間で関数をグループ化して適用するR

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 
} 

次のデータセットは、my関数の出力とともに示しています。それは期待どおりに動作し、小さなデータセットでは素早く動作します。しかし、多くの場合、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))