Есть ли способ использовать функцию pmap в purrr для итеративной настройки набора данных? - PullRequest
Новая
       39

Есть ли способ использовать функцию pmap в purrr для итеративной настройки набора данных?

0 голосов
/ 24 февраля 2020

Я создал функцию, которую пытаюсь применить к набору данных с помощью pmap. Функция, которую я создал, исправляет некоторые столбцы в наборе данных. Я хочу, чтобы поправка, примененная к двум столбцам, была перенесена на 2-ю и последующие итерации 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?

1 Ответ

1 голос
/ 26 февраля 2020

Вы можете итеративно применять функцию к вашему набору данных с помощью 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)
...