R:将多个参数传递给 accumulate/reduce

R: pass multiple arguments to accumulate/reduce

这与

有关

我意识到我面临的实际问题比我在上面的线程中给出的示例要复杂一些 - 似乎我必须将 3 个参数传递给递归计算才能实现我想要的。因此,accumulate2reduce 可能不起作用。所以我在这里开一个新问题以避免可能的混淆。

我有以下按 ID 分组的数据集:

ID <- c(1, 2, 2, 3, 3, 3)
pw <- c(1:6)
add <- c(1, 2, 3, 5, 7, 8)
x <- c(1, 2, NA, 4, NA, NA)
df <- data.frame(ID, pw, add, x)

df
  ID pw add  x
1  1  1   1  1
2  2  2   2  2
3  2  3   3 NA
4  3  4   5  4
5  3  5   7 NA
6  3  6   8 NA

在列 x 的每个组中,我想保持第一行的值不变,同时用滞后值填充剩余的行,提升到存储在 pw 中的幂, 并将 add 中的值添加到指数中。我想在进行时更新滞后值。所以我想要:

  ID pw add  x
1  1  1   1  1
2  2  2   2  2
3  2  3   3 2^3 + 3
4  3  4   5  4
5  3  5   7 4^5 + 7
6  3  6   8 (4^5 + 7)^6 + 8 

我必须将此计算应用于大型数据集,因此如果有快速的方法来执行此操作将是完美的!

如果我们想使用 accumulate2,那么请正确指定参数,即它需要两个输入参数 'pw' 和 'add' 以及一个初始化参数 first 'x' 的值。因为它是按 'ID' 分组的,所以在我们执行 accumulate2 之前进行分组,分别提取 lambda 默认参数 ..1..2..3基于此

排序并创建递归函数
library(dplyr)
library(purrr)
out <- df %>%
   group_by(ID) %>% 
   mutate(x1 = accumulate2(pw[-1], add[-1], ~  ..1^..2 + ..3, 
             .init = first(x)) %>%
                flatten_dbl ) %>%
   ungroup

out$x1
#[1]    1                   2                  11   
#[4]    4                1031 1201024845477409792

如果参数超过 3 个,for 循环会更好

# // initialize an empty vector
out <- c()
# // loop over the `unique` ID
for(id in  unique(df$ID)) {
    # // create a temporary subset of data based on that id
    tmp_df <- subset(df, ID == id)
     # // initialize a temporary storage output
     tmp_out <- numeric(nrow(tmp_df))
     # // initialize first value with the first element of x
     tmp_out[1] <- tmp_df$x[1]
    # // if the number of rows is greater than 1
    if(nrow(tmp_df) > 1) {
       // loop over the rows
      for(i in 2:nrow(tmp_df)) {
        #// do the recursive calculation and update
        tmp_out[i] <- tmp_out[i - 1]^ tmp_df$pw[i] + tmp_df$add[i]
        }
      } 
     
     out <- c(out, tmp_out)

}

out
#[1] 1                   2                  11     
#[4] 4                1031 1201024845477409792

Base R,不使用 Reduce() 而是 while() 循环:

# Split-apply-combine while loop: res => data.frame
res <- do.call(rbind, lapply(with(df, split(df, ID)), function(y){
  # While there are any NAs in x: 
      while(any(is.na(y$x))){
        # Store the index of the first NA value: idx => integer scalar
        idx <- with(y, head(which(is.na(x)), 1))
        # Calculate x at that index using the business rule provided: 
        # x => numeric vector
        y$x[idx] <- with(y, x[(idx-1)] ** pw[idx] + add[idx])
      }
  # Explicitly define the return object: y => GlobalEnv
     y
    }
  )
)

或递归函数:

# Recursive function: estimation_func => function() 
estimation_func <- function(value_vec, exponent_vec, add_vec){
  # Specify the termination condition; when all elements 
  # of value_vec are no longer NA:
  if(all(!(is.na(value_vec)))){
    # Return value_vec: numeric vector => GlobalEnv
    return(value_vec)
  # Otherwise recursively apply the below: 
  }else{
    # Store the index of the first na value: idx => integer vector
    idx <- Position(is.na, value_vec)
    # Calculate the value of the value_vec at that index; 
    # using the provided business logic: value_vec => numeric vector
    value_vec[idx] <- (value_vec[(idx-1)] ** exponent_vec[idx]) + add_vec[idx]
    # Recursively apply function: function => Local Env
    return(estimation_func(value_vec, exponent_vec, add_vec))
  }
}

# Split data.frame into a list on ID; 
# Overwrite x values, applying recursive function;
# Combine list into a data.frame
# res => data.frame
res <- data.frame( 
  do.call(
    rbind, 
    Map(function(y){y$x <- estimation_func(y$x, y$pw, y$add); y}, split(df, df$ID))
  ), row.names = NULL
)

base R 中,我们可以对两个以上的参数使用以下解决方案。

  • 在这个解决方案中,我首先在 ID
  • 上对原始数据集进行子集化
  • 然后我通过 seq_len(nrow(tmp))[-1] 选择了行 ID 值,省略了第一行 ID,因为它是由 init
  • 提供的
  • 在我在 Reduce 中使用的匿名函数中,b 参数表示从 init 开始的累积/先前值,而 c 表示我们的 new/current 值行号向量
  • 所以在每次迭代中,我们以前的值(从 init 开始)将被提升到 pw 的新值的幂,并将与 add[ 的新值相加=38=]
cbind(df[-length(df)], unlist(lapply(unique(df$ID), function(a) {
  tmp <- subset(df, df$ID == a)
  Reduce(function(b, c) {
    b ^ tmp$pw[c] + tmp$add[c]
  }, init = tmp$x[1],
  seq_len(nrow(tmp))[-1], accumulate = TRUE)
}))) |> setNames(c(names(df)))

  ID pw add            x
1  1  1   1 1.000000e+00
2  2  2   2 2.000000e+00
3  2  3   3 1.100000e+01
4  3  4   5 4.000000e+00
5  3  5   7 1.031000e+03
6  3  6   8 1.201025e+18

数据

structure(list(ID = c(1, 2, 2, 3, 3, 3), pw = 1:6, add = c(1, 
2, 3, 5, 7, 8), x = c(1, 2, NA, 4, NA, NA)), class = "data.frame", row.names = c(NA, 
-6L))