问题描述
这与R: use the newly generated data in the previous row
有关我意识到我面临的实际问题比我在上面线程中给出的示例要复杂一些 - 似乎我必须将 3 个参数传递给递归计算才能实现我想要的。因此，accumulate2 或 reduce 可能不起作用。所以我在这里提出一个新问题以避免可能的混淆。
我有以下按 ID 分组的数据集：
ID <- c(1,2,3,3)
pw <- c(1:6)
add <- c(1,5,7,8)
x <- c(1,NA,4,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' 以及一个初始化参数，它是 'x 的 first 值'。由于它是按“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
在基础 R 中，我们可以对两个以上的参数使用以下解决方案。
- 在这个解决方案中，我首先对
ID值的原始数据集进行子集 - 然后我通过
seq_len(nrow(tmp))[-1]选择了 row id 值，省略了第一行 id，因为它是由init提供的 - 在我在
Reduce中使用的匿名函数中，b参数表示从init开始的累积/先前值，c表示我们的向量的新/当前值，即行数字 - 因此，在每次迭代中，我们之前的值（从
init开始）将被提升到来自pw的新值的幂，并将与来自add的新值相加
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,3,3),pw = 1:6,add = c(1,5,7,8),x = c(1,NA,4,NA)),class = "data.frame",row.names = c(NA,-6L))
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
}
)
)
OR 递归函数：
# 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,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},df$ID))
),row.names = NULL
)