Создать записи в фрейме данных R между двумя датами

Question

У меня есть фрейм данных, который состоит из запланированных платежей подписки клиентов следующим образом:

CusID <- c(1,2,3)
FromDate <- c(ymd("2019-01-01"), ymd("2019-01-04"), ymd("2019-02-02"))
ToDate <-c(ymd("2019-01-16"), ymd("2019-01-15"), ymd("2019-04-03"))
Amount <- c(5,10,12)
Frequency <- c("Weekly", "Fortnightly", "Monthly")
Input <-  data.frame(CusID, Amount, Frequency, FromDate, ToDate)

Для каждой строки (клиента) я хочу выполнить цикл от FromDate до ToDate и вывести одну строку каждогоданные для каждого запланированного платежа, которые попадают между этими датами, приводя к следующему фрейму данных:

CusID <- c(1,1,1,2,3,3,3)
PaymentDate <- c(ymd("2019-01-01"), ymd("2019-01-08"), ymd("2019-01-15"),
                 ymd("2019-01-04"),ymd("2019-02-02"),ymd("2019-03-02"),ymd("2019-04-02"))
Amount <- c(5,5,5,10,12,12,12)
Output <-  data.frame(CusID, PaymentDate, Amount)

Как эффективный способ добиться этого с использованием R (и предпочтительно с использованием функций dplyr / tidyverse)?

В SAS мой подход заключается в том, чтобы использовать операторы DO / WHILE LOOP и OUTPUT для записи новой строки для каждого запланированного платежа. Например,

data Output;
set Input;
PaymentDate = FromDate;
do while (PaymentDate < ToDate);
Payment = Amount;
PaymentDate = PaymentDate + (7 / 14 / 30 ~ logic based on Frequency);
output;
loop;
run;

(Ключевым моментом в SAS является оператор вывода - он явно записывает новую запись при каждом вызове, поэтому может использоваться в цикле для записи нескольких выходных строк на входную строку).

Есть ли эквивалентный метод, доступный в R, или рекомендуется другой подход?

Answer 1

Другой вариант с использованием tidyverse

Input %>%
  mutate(Frequency = case_when(Frequency == "Weekly" ~ 7L,
                               Frequency == "Fortnightly" ~ 14L,
                               Frequency == "Monthly" ~ 30L,
                               TRUE ~ 0L)) %>%
  group_by(CusID) %>%
  group_modify(~ {PaymentDate <- seq.Date(from = .x$FromDate, to = .x$ToDate, by = .x$Frequency) 
                 crossing(.x[,1], PaymentDate)})  


# A tibble: 7 x 3
# Groups:   CusID [3]
  CusID PaymentDate Amount
  <dbl> <date>       <dbl>
1     1 2019-01-01       5
2     1 2019-01-08       5
3     1 2019-01-15       5
4     2 2019-01-04      10
5     3 2019-02-02      12
6     3 2019-03-04      12
7     3 2019-04-03      12

Даты оплаты немного отличаются от ожидаемого результата, поскольку seq.Date добавляет 30 дней с учетом разного количества дней в этих месяцах.

ОБНОВЛЕНИЕ:

Вот более дословное решение

Input %>% 
  mutate(PaymentDate = FromDate,
         RFrequency = case_when(Frequency == "Weekly" ~ '1 week',
                                Frequency == "Fortnightly" ~ '2 weeks',
                                Frequency == "Monthly" ~ '1 month')) %>% 
  group_by(CusID, Amount) %>% 
  expand(PaymentDate = seq.Date(FromDate,ToDate, by = RFrequency)) 

# A tibble: 7 x 3
# Groups:   CusID, Amount [3]
  CusID Amount PaymentDate
  <dbl>  <dbl> <date>     
1     1      5 2019-01-01 
2     1      5 2019-01-08 
3     1      5 2019-01-15 
4     2     10 2019-01-04 
5     3     12 2019-02-02 
6     3     12 2019-03-02 
7     3     12 2019-04-02 

Answer 2

Я настроил ваш Input data.frame так, чтобы значения Частоты были строками, а не факторами.

Вы можете создать вспомогательную таблицу freq_mapping для преобразования из вашей Частоты в формат частоты, который любит R. Это позволило бы избежать 30-дневной проблемы, на которую указывал один из других ответов.

freq_mapping <- data.frame(Frequency=c('Weekly', 'Fortnightly', 'Monthly'), 
                           RFrequency = c('1 week', '2 weeks', '1 month'),
                           stringsAsFactors =  FALSE)

Затем объедините ввод с этим:

Input <- Input %>%
    inner_join(freq_mapping, by = 'Frequency')

Теперь вы можете создать даты платежа:

Input$PaymentDate <- Input$FromDate
Input %>% 
    group_by(CusID) %>% 
    complete(PaymentDate = seq.Date(FromDate,ToDate, by = RFrequency)) %>% 
    fill(PaymentDate,Amount) %>% 
    select(CusID, PaymentDate, Amount)

Answer 3

Месив из ответов Humpelstielzchen и user2474226, чтобы объединить всю логику в один шаг dplyr.

Output <- Input %>% 
  mutate(PaymentDate = FromDate,
         RFrequency = case_when(Frequency == "Weekly" ~ '1 week',
                                Frequency == "Fortnightly" ~ '2 weeks',
                                Frequency == "Monthly" ~ '1 month')) %>% 
  group_by(CusID) %>% 
  complete(PaymentDate = seq.Date(FromDate,ToDate, by = RFrequency)) %>% 
  fill(PaymentDate,Amount) %>% 
  select(CusID, PaymentDate, Amount)

Answer 4

не такая уж легкая проблема для меня. Решение не красиво, но оно должно как-то делать работу. Вы увидите, что существует проблема с ежемесячным платежом, который не всегда 30, но в противном случае он должен работать. Но лучшее решение, безусловно, существует.

    library(data.table)
Input <-  data.frame(CusID, Amount, Frequency, FromDate, ToDate)

Input=data.table(Input)
Input[Frequency=="Weekly",freq:=7][Frequency=="Fortnightly",freq:=14][Frequency=="Monthly",freq:=30]
Input[,Ratio:=(ToDate-FromDate)/freq]

#What is the maximum rows ? for a customer ?
NREP=as.integer(max(ceiling(Input$Ratio)))

Input[,Rep:=1][,PaymentDate:=FromDate]
for(i in 1:NREP){
Inputtemp=copy(Input)
Inputtemp[,FromDate:=FromDate+freq]
Input=rbind(Input,Inputtemp)  
}

#Remove invalid rows
Input=unique(Input)

Input=Input[!(FromDate>ToDate),]
setorder(Input,CusID)
Input=Input[,c("CusID","FromDate","Amount")]
setnames(Input,"FromDate","PaymentDate")
Input==data.table(Output)