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”，并返回调整后的数据集作为列表中的第一个元素。然后，它将共享限制应用于列“ b”和“ d”，并将其作为列表中的第二个元素返回。但是，对“ 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，并使用x参数将数据集设置为初始.init。在每次迭代时，来自shared_limits_args_list的参数子列表将以y的形式传递给函数。 [[用于选择每个位置的列表元素。该函数的输出数据帧将成为下一个迭代的新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函数来迭代地调整数据集？

1 个答案: