Как мне получить наклоны интерполяции в обычные моменты времени на графике совокупной суммы?

При перекрестной проверке я задал вопрос об анализе данных по дате, но не хочу генерировать ложные всплески и минимумы путем объединения данных по месяцам .Например, если кто-то оплачивает счет в последний день каждого месяца, но в одном случае он оплачивает с опозданием на несколько дней, тогда один месяц будет отражать нулевые расходы, а следующий месяц будет отражать двойные обычные расходы. Все фальшивое барахло.

Один из ответов на мой вопрос объясняет концепцию интерполяции с использованием линейного сглаживания сплайнов на кумулятивной сумме для преодоления икоты при биннинге. Я заинтригован этим и хочу реализовать его на R, но не могу найти никаких примеров в Интернете. Я не просто хочу печатать сюжеты. Я хочу получить мгновенный наклон в каждый момент времени (возможно, каждый день), но этот наклон должен быть получен из сплайна, который вводит точки от нескольких дней (или, возможно, нескольких недель или нескольких месяцев) до нескольких дней. после момента времени. Другими словами, в конце дня я хочу получить что-то вроде фрейма данных, в котором один столбец - это деньги в день или количество пациентов в неделю, но это не зависит от таких капризов, как то, заплатил ли я опоздание на несколько дней или в месяце было 5 рабочих дней (в отличие от обычных 4).

Вот упрощенное моделирование и построение графика, показывающие, с чем я борюсь.

library(lubridate)
library(ggplot2)
library(reshape2)
dates <- seq(as.Date("2010-02-01"), length=24, by="1 month") - 1
dates[5] <- dates[5]+3 #we are making one payment date that is 3 days late
dates#look how the payment date is the last day of every month except for
#2010-05 where it takes place on 2010-06-03 - naughty boy!
amounts <- rep(50,each=24)# pay $50 every month
register <- data.frame(dates,amounts)#this is the starting register or ledger
ggplot(data=register,aes(dates,amounts))+geom_point()#look carefully and you will see that 2010-05 has no dots in it and 2010-06 has two dots
register.by.month <- ddply(register,.(y=year(dates),month=month(dates)),summarise,month.tot=sum(amounts))#create a summary of totals by month but it lands up omiting a month in which nothing happened. Further badness is that it creates a new dataframe where one is not needed. Instead I created a new variable that allocates each date into a particular "zone" such as month or 
register$cutmonth <- as.Date(cut(register$dates, breaks = "month"))#until recently I did not know that the cut function can handle dates
table(register$cutmonth)#see how there are two payments in the month of 2010-06
#now lets look at what we paid each month. What is the total for each month
ggplot(register, aes(cutmonth, amounts))+ stat_summary(fun.y = sum, geom = "bar")#that is the truth but it is a useless truth

#so lets use cummulated expense over time
register$cumamount <- cumsum(register$amounts)
cum <- ggplot(data=register,aes(dates,cumamount))+geom_point()
cum+stat_smooth()

#That was for everything the same every month, now lets introduce a situation where there is a trend that in the second year the amounts start to go up, 
increase <- c(rep(1,each=12),seq(from=1.01,to=1.9,length.out=12))
amounts.up <- round(amounts*increase,digits=2)#this is the monthly amount with a growth of amount in each month of the second year
register <- cbind(register,amounts.up)#add the variable to the data frarme
register$cumamount.up <- cumsum(register$amounts.up) #work out th cumulative sum for the new scenario
ggplot(data=register,aes(x=dates))+
   geom_point(aes(y=amounts, colour="amounts",shape="amounts"))+
   geom_point(aes(y=amounts.up, colour="amounts.up",shape="amounts.up"))# the plot of amount by date
#I am now going to plot the cumulative amount over time but now that I have two scenarios it is easier to deal with the data frame in long format (melted) rather than wide format (casted)
#before I can melt, the reshape2 package unforutnately can't handle date class so will have to turn them int o characters and then back again.
register[,c("dates","cutmonth")] <- lapply(register[,c("dates","cutmonth")],as.character)
register.long <- melt.data.frame(register,measure.vars=c("amounts","amounts.up"))
register.long[,c("dates","cutmonth")] <- lapply(register.long[,c("dates","cutmonth")],as.Date)
ggplot(register.long, aes(cutmonth,value))+ stat_summary(fun.y = sum, geom = "bar")+facet_grid(. ~ variable) #that is the truth but it is a useless truth, 
cum <- ggplot(data=register,aes(dates,cumamount))+geom_point()
#that is the truth but it is a useless truth. Furthermore it appears as if 2010-06 is similar to what is going on in 2011-12
#that is patently absurd. All that happened was that the 2010-05 payment was delayed by 3 days.

#so lets use cummulated expense over time    
ggplot(data=register.long,aes(dates,c(cumamount,cumamount.up)))+geom_point() + scale_y_continuous(name='cumulative sum of amounts ($)')

Таким образом, для простого графика переменная interpolate.daily будет около 50 / 30,4 = 1,64 доллара в день на каждый день года. Для второго графика, где сумма, выплачиваемая каждый месяц, начинает расти каждый месяц во втором году, будет отображаться ежедневная ставка 1,64 доллара в день за каждый день в первый год, а для дат во второй год будут отображаться дневные ставки. постепенно увеличиваясь с 1,64 доллара в день до примерно 3 долларов.12 в день.

Большое спасибо за то, что дочитали это до конца. Вы, должно быть, были заинтригованы не меньше меня!