Hoe krijg ik de hellingen van een interpolatie op reguliere tijdstippen op een cumulatieve somplot?

Bij cross-validatie heb ik een vraag gevraagd over het analyseren van gegevens op datum, maar wil ik geen valse spikes en troggen genereren door te binning gegevens per maand. Bijvoorbeeld als iemand op de laatste dag van elke maand een rekening betaalt, maar bij een gelegenheid betaalt men een paar dagen te laat, dan geeft de ene maand geen kosten weer en de volgende maand zal het dubbele van de gebruikelijke kosten weerspiegelen. Alle valse rotzooi.

Een van de antwoorden op mijn vraag legde het concept van interpolatie uit met behulp van lineaire spline-smoothing op de cumulatieve som om hikken tegen te gaan in binning. Ik ben er geïntrigeerd door en wil het in R implementeren, maar ik kan geen voorbeelden online vinden. Ik wil niet alleen plots afdrukken. Ik wil de momentane helling op elk tijdstip (misschien elke dag), maar die helling moet worden afgeleid van een spline die punten invoert van een paar dagen (of misschien een paar weken of een paar maanden) vóór tot een paar dagen na het tijdstip. Met andere woorden, aan het einde van de dag wil ik iets krijgen zoals een dataframe waarin één kolom geld per dag is of patiënten per week, maar dat is niet onderhevig aan grillen zoals of ik een paar dagen te laat betaald of dat er 5 operaties in de maand waren (in tegenstelling tot de gebruikelijke 4).

Hier is wat vereenvoudigde simulatie en compilatie om te laten zien waar ik tegen sta.

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

When one is late with a payment by a couple of days it appears as if the expense was zero in one month and double in the next. That is spurious

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

cumulative amount over time smooths out variability that changes an item's bin

#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.

two scenarios but showing the amount of money paid in each month

#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 ($)')

Here we see the cumulative sum data for the two scenarios

Dus voor de eenvoudige plot zou de variabele interpolate.daily ongeveer $ 50/30,4 = $ 1,64 per dag zijn voor elke dag van het jaar. Voor het tweede perceel waarbij het bedrag dat elke maand wordt betaald elke maand in het tweede jaar begint te stijgen, wordt een dagtarief van $ 1,64 per dag voor elke dag in het eerste jaar en voor datums in het tweede jaar worden de dagelijkse tarieven weergegeven geleidelijk stijgend van $ 1,64 per dag naar ongeveer $ 3,12 per dag.

Heel erg bedankt voor het lezen van dit helemaal tot het einde. Je bent vast net zo geïntrigeerd als ik!

10
Ik denk dat je slecht advies hebt gekregen - een meer algemene statistische manier om dit te doen zou zijn om een ​​kerneldichtheidsraming te gebruiken.
toegevoegd de auteur hadley, de bron
Het is triviaal in ggplot2 - gebruik gewoon geom = "density"
toegevoegd de auteur hadley, de bron
@hadley Een van de respondenten van mijn vraag heeft gesproken over schattingen van de dichtheid en kernels . Helaas begreep ik het niet veel en gaf hij een implementatie in Matlab waar ik nog nooit mee heb gewerkt.
toegevoegd de auteur Farrel, de bron
@hadley Betekent dit dat iemand iets zou doen zoals deze cum <- ggplot (data = register, aes (datums, cumamount)) + geom_point() en dan cum + geom_density ( ) . Maar helaas krijg ik Fout in data.frame (lijst (x = c (14640, 14641.3679060665, 14642.7358121331,: argumenten impliceren een verschillend aantal rijen: 512, 1, 91 Hoe dan ook, zelfs als ik geom_density gebruik hoe krijg ik een gegevenstabel van de nieuwe waarden per maand of per dag die niet worden verknoeid door binning?
toegevoegd de auteur Farrel, de bron

1 antwoord

Hier is een eenvoudige manier om het te doen. Natuurlijk zijn er complexere opties en parameters om te tweaken, maar dit zou een goed startpunt moeten zijn.

dates <- seq(as.Date("2010-02-01"), length=24, by="1 month") - 1
dates[5] <- dates[5]+3
amounts <- rep(50,each=24)
increase <- c(rep(1,each=12),seq(from=1.01,to=1.9,length.out=12))
amounts.up <- round(amounts*increase,digits=2)

df = data.frame(dates=dates, cumamount.up=cumsum(amounts.up))

df.spline = splinefun(df$dates, df$cumamount.up)

newdates = seq(min(df$dates), max(df$dates), by=1)
money.per.day = df.spline(newdates, deriv=1)

Als je het plot, kun je het interessante gedrag van de splines zien:

plot(newdates, money.per.day, type='l')

enter image description here

1
toegevoegd
Dank u zeer. Van de persoon die mij over deze techniek vertelde, kreeg ik het advies dat de cumulatieve som monotoon zou stijgen vanwege de niet-negativiteit van de oorspronkelijke waarden. Dat gezegd hebbende, denk ik dat de spline lineair moet zijn of op monotoon moet worden gezet. Ik zal de splinefun-functie verkennen. Maar ik ben blij dat je me liet zien hoe je een stel x's tegen de afgeleide formule gooide.
toegevoegd de auteur Farrel, de bron
Ik ga morgen hiermee spelen. Ik kan niet wachten
toegevoegd de auteur Farrel, de bron
Ik weet niet veel over splines en ik veronderstel dat deriv = 1 een calculusderivaat is en ik ook weinig over calculus weet. Het volstaat om te zeggen dat de bovenstaande grafiek niet correct is omdat er veel te veel schommelingen zijn. Ja, het zal op en neer gaan, maar met heel weinig, vooral in het eerste jaar. Dus ik heb geprobeerd de splinefun methode = "mono" te forceren maar elke keer dat ik dat doe, krijg ik het volgende scenario > money.per.day <- register.spline (newdates, deriv = 1) Fout in as.Datum.numeriek (waarde): 'oorsprong' moet worden opgegeven
toegevoegd de auteur Farrel, de bron
ook FYI, Prof Hyndman heeft hier een monotone spline-functie: robjhyndman.com/software/monotonic-splines
toegevoegd de auteur tim riffe, de bron
@Farrel Great Ik ben blij dat het helpt. Absoluut slim om de opties te verkennen zoals je zei. Het cumsum neemt inderdaad monotoon toe (probeer plot (df); lines (newdates, df.spline (newdates)) om te zien), maar de eerste afgeleide die je wilde (dat wil zeggen geld/dag) is niet . Het zal op en neer gaan als je van een lange naar een korte maand gaat, enz.
toegevoegd de auteur John Colby, de bron