有没有一种方法可以使用 purrr 中的 pmap 函数来迭代调整数据集？

Question

我创建了一个函数，我正尝试使用 pmap 将其应用于数据集。我创建的函数修改了数据集中的某些列。我希望将应用于两列的修改延续到 pmap 的第二次和后续迭代。

下面的可重现示例：

library(tidyr)
library(dplyr)

set.seed(1982)

#create example dataset
dataset <- tibble(groupvar =  sample(c(1:3), 20, replace = TRUE),
                  a = sample(c(1:10), 20, replace = TRUE),
                  b = sample(c(1:10), 20, replace = TRUE),
                  c = sample(c(1:10), 20, replace = TRUE),
                  d = sample(c(1:10), 20, replace = TRUE)) %>%
  arrange(groupvar)


#function to sum 2 columns (col1 and col2), then adjust those columns such that the cumulative sum of the two columns
#within the group doesn't exceed the specified limit
shared_limits <- function(col1, col2, group, limit){
  dataset <- dataset
  dataset$group <- dataset[[group]]
  dataset$newcol <- dataset[[col1]] + dataset[[col2]]
  dataset <- dataset %>% group_by(groupvar) %>% mutate(cumulative_sum=cumsum(newcol))
  dataset$limited_cumulative_sum <- ifelse(dataset$cumulative_sum>limit, limit, dataset$cumulative_sum)
  dataset <- dataset %>% group_by(groupvar) %>% mutate(limited_cumulative_sum_lag=lag(limited_cumulative_sum)) 
  dataset$limited_cumulative_sum_lag <- ifelse(is.na(dataset$limited_cumulative_sum_lag),0,dataset$limited_cumulative_sum_lag)
  dataset$adjusted_sum <- dataset$limited_cumulative_sum - dataset$limited_cumulative_sum_lag
  dataset[[col1]] <- ifelse(dataset$adjusted_sum==dataset$newcol, dataset[[col1]],
                                                           pmin(dataset[[col1]], dataset$adjusted_sum))
  dataset[[col2]] <- dataset$adjusted_sum - dataset[[col1]]
  dataset <- dataset %>% ungroup() %>% dplyr::select(-group, -newcol, -cumulative_sum, -limited_cumulative_sum, -limited_cumulative_sum_lag, -adjusted_sum)
  dataset
}

#apply function directly
new_dataset <- shared_limits("a", "b", "groupvar", 25)

#apply function using a separate parameters table and pmap_dfr
shared_limits_table <- tibble(col1 = c("a","b"),
                              col2 = c("c","d"),
                              group = "groupvar",
                              limit = c(25, 30))

dataset <- pmap_dfr(shared_limits_table, shared_limits)

在上面的示例中，pmap 函数将共享限制应用于列 "a" 和 "c" 以及 returns 调整后的数据集作为列表中的第一个元素。然后它将共享限制应用于列 "b" 和 "d" 以及 returns 并将其作为列表中的第二个元素。但是，对 "a" 和 "c" 所做的调整现已丢失。

有没有什么方法可以存储我们在 pmap 的每次迭代中对每一列所做的调整？

Answer 1

您可以使用 reduce

将函数迭代应用于您的数据集

首先，我会修复你的函数，因为 dataset 未定义

shared_limits <- function(df, col1, col2, group, limit){
  dataset <- df
  dataset$group <- dataset[[group]]
  dataset$newcol <- dataset[[col1]] + dataset[[col2]]
  dataset <- dataset %>% group_by(groupvar) %>% mutate(cumulative_sum=cumsum(newcol))
  dataset$limited_cumulative_sum <- ifelse(dataset$cumulative_sum>limit, limit, dataset$cumulative_sum)
  dataset <- dataset %>% group_by(groupvar) %>% mutate(limited_cumulative_sum_lag=lag(limited_cumulative_sum)) 
  dataset$limited_cumulative_sum_lag <- ifelse(is.na(dataset$limited_cumulative_sum_lag),0,dataset$limited_cumulative_sum_lag)
  dataset$adjusted_sum <- dataset$limited_cumulative_sum - dataset$limited_cumulative_sum_lag
  dataset[[col1]] <- ifelse(dataset$adjusted_sum==dataset$newcol, dataset[[col1]],
                                                           pmin(dataset[[col1]], dataset$adjusted_sum))
  dataset[[col2]] <- dataset$adjusted_sum - dataset[[col1]]
  dataset <- dataset %>% ungroup() %>% dplyr::select(-group, -newcol, -cumulative_sum, -limited_cumulative_sum, -limited_cumulative_sum_lag, -adjusted_sum)
  dataset
}

然后列出要在每一步传递给函数的参数

shared_limits_args_list <- list(
    list("a", "c", "groupvar", 25), 
    list("b", "d", "groupvar", 30))

然后调用 reduce，使用 .init 参数将数据集设置为您的初始 x。在每次迭代中，来自 shared_limits_args_list 的参数子列表将作为 y 传递给函数。 [[用于select每个位置的列表元素。该函数的输出数据帧将成为下一次迭代的新 x，而 shared_limits_args_list 的下一个子列表将成为下一组参数。当 shared_limits_args_list 的所有子列表都被使用后，输出最终的数据帧。

dataset_combined <- 
    reduce(shared_limits_args_list, 
    function(x,y) shared_limits(df=x, y[[1]], y[[2]], y[[3]], y[[4]]),
    .init=dataset)

有没有一种方法可以使用 purrr 中的 pmap 函数来迭代调整数据集？

Is there a way of using the pmap function in purrr to iteratively adjust a dataset?

r

pmap

dplyr

purrr