Линейное распределение сумм по месяцам

Question

Пожалуйста, рассмотрите следующий синтетический фрейм данных:

#Learning to enable splitting contributions spanning two months

start = c(as.Date("2013-01-01"), as.Date("2013-02-01"), as.Date("2013-04-01"), as.Date("2013-04-16"), as.Date("2013-05-16"))
end = c(as.Date("2013-01-31"), as.Date("2013-03-31"), as.Date("2013-04-15"), as.Date("2013-05-15"), as.Date("2013-05-31"))
amount = c(100, 200, 50, 100, 50)

df = data.frame(start,end,amount)

Это список полученных денежных средств и период времени, к которому он относится. Некоторые из этих периодов времени занимают два месяца. Я хотел бы объединить это по месяцам. Для тех сумм, которые относятся к периоду, который охватывает два месяца, я хотел бы линейно распределить / распределить их между двумя месяцами.

Каков был бы идиоматически правильный способ сделать это в R?

Answer 1

Создать функцию explode это разрывает интервал в фрейм данных с одной строкой в день. использование Map применять explode к каждому интервалу, формирующему список фреймов данных, по одному на интервал. следующий rbind кадры данных в списке в один большой кадр данных, by.dateимея один ряд в день. Наконец, совокупность by.date в один ряд для каждого года / месяца:

library(zoo) # as.yearmon

explode <- function(start, end, amount) {
   dates <- seq(start, end, "day")
   data.frame(dates, yearmon = as.yearmon(dates), amount = amount / length(dates))
}
by.date <- do.call("rbind", Map(explode, df$start, df$end, df$amount))
aggregate(amount ~ yearmon, by.date, sum)

Используя данные в вопросе (предполагая, что наступление 2010 года должно было стать 2013 годом), мы получаем:

   yearmon    amount
1 Jan 2013 100.00000
2 Feb 2013  94.91525
3 Mar 2013 105.08475
4 Apr 2013 100.00000
5 May 2013 100.00000

ОБНОВЛЕНИЕ: если память - проблема, используйте это для explode вместо. Агрегирует в explode во-первых, чтобы его выход был меньше. Также мы устранили dates колонка в DF так как он был включен только для отладки:

explode <- function(start, end, amount) {
   dates <- seq(start, end, "day")
   DF <- data.frame(yearmon = as.yearmon(dates), amount = amount / length(dates))
   aggregate(amount ~ yearmon, DF, sum)
}

ОБНОВЛЕНИЕ 2: Вот еще одна попытка. Оно использует rowsum который специализируется на суммировании сумм. Этот тест работал в 10 раз быстрее, чем данные в посте в моем тесте.

explode2 <- function(start, end, amount) {
  dates <- seq(start, end, "day")
  n <- length(dates)
  rowsum(rep(amount, n) / n, format(dates, "%Y-%m"))
}
by.date <- do.call("rbind", Map(explode2, df$start, df$end, df$amount))
rowsum(by.date, rownames(by.date))