10

Cross Validated で、日付ごとにデータを分析することについて質問しましたが、月ごとにデータをビニングすることによって誤ったスパイクと谷を生成したくありませんでした。たとえば、毎月の最終日に請求書を支払い、ある場合には数日遅れて支払う場合、その月は費用がゼロになり、翌月は通常の費用の 2 倍になります。すべて偽のがらくた。

私の質問に対する回答の 1 つは、ビニングでの問題を克服するために、累積合計に対して線形スプライン スムージングを使用した補間の概念を説明していました。私はそれに興味をそそられ、Rで実装したいと思っていますが、オンラインで例を見つけることができません. プロットを印刷したいだけではありません。あらゆる時点 (おそらく毎日) で瞬時の勾配を取得したいのですが、その勾配は、数日前 (またはおそらく数週間または数か月) から数日前のポイントを入力するスプラインから導出する必要があります。時点の後。言い換えれば、一日の終わりに、1 列が 1 日あたりのお金であるデータ フレームなどを取得したいのです。または週あたりの患者ですが、それは、私が数日遅れて支払ったかどうか、または月にたまたま手術日が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

支払いが数日遅れると、ある月の費用がゼロで、次の月には 2 倍になったかのように見えます。 それは偽物です

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

2 つのシナリオですが、各月に支払われた金額を示しています

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

ここに、2 つのシナリオの累積合計データが表示されます

したがって、単純なプロットの場合、変数 interpolate.daily は、年間を通じて 1 日あたり約 $50/30.4 = $1.64 になります。毎月支払われる金額が 2 年目に毎月増加し始める 2 番目のプロットでは、最初の年は毎日 $1.64 の日率が表示され、2 年目の日付では日率が表示されます。 1 日あたり 1.64 ドルから 1 日あたり約 3.12 ドルまで徐々に上昇しています。

最後までお読みいただき、誠にありがとうございました。あなたも私と同じくらい興味をそそられたに違いありません!

4

1 に答える 1

1

これを行う基本的な方法の 1 つを次に示します。もちろん、より複雑なオプションや微調整するパラメーターがありますが、これは良い出発点になるはずです。

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)

プロットすると、スプラインの興味深い動作を確認できます。

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

ここに画像の説明を入力

于 2011-12-07T03:49:07.983 に答える