ggglot2 のさまざまなグラフの例(統計的観点から)
背景と目的
さまざまな統計データを扱う上で、グラフなどへの可視化はとても重要な手段である。ggplot2 は統計的ツールとして有名な R のグラフライブラリであり、本ブログでもその使い方を紹介している。ここでは、その具体的な例として、三重大の奥村先生が公開しているグラフの描き方に描かれている素晴らしい統計的グラフの数々を、練習をかねて ggplot2 で描いてみる。
テーマのカスタマイズ
ggplot2 ではデフォルトでも十分美しいグラフが描ける。ここでは、グラフの描き方により近いグラフを描くために、一貫してggplot2 のテーマを作成 - joker8phoenix の日記のテーマを利用する。このテーマをmyggplot2.Rとして保存して、
source("~/[ファイルの場所]/myggplot2.R")
とすれば、mytheme()というテーマを定義できる。
棒グラフ・柱状グラフ
地域別面積
- データ
region = c("北海道","本州","四国","九州","沖縄") area = c(83457,231113,18792,42191,2276)/10000
- グラフ
- ソース
source("~/[ファイルの場所]/myggplot2.R") # 自分の環境に合わせる quartz(width=8.267717,height=5.826772) # Macのみ利用可能 areadata = data.frame(region=region,area=area,ord=c(1:5)) garea <- ggplot(areadata) garea <- garea + geom_bar(aes(x=reorder(region,ord),weight=area),fill="grey",colour="black") garea <- garea + labs(x=NULL, y=expression(paste("面積(万", km^2, ")"))) garea <- garea + mytheme() garea <- garea + coord_cartesian(ylim=c(0,25)) garea grid.gedit("text", gp=gpar(fontfamily="HiraMaruProN-W4"))
都道府県別人口
- データ
kenmei = c("北海道", "青森県", "岩手県", "宮城県", "秋田県", "山形県", "福島県", "茨城県", "栃木県", "群馬県", "埼玉県", "千葉県", "東京都", "神奈川県", "新潟県", "富山県", "石川県", "福井県", "山梨県", "長野県", "岐阜県", "静岡県", "愛知県", "三重県", "滋賀県", "京都府", "大阪府", "兵庫県", "奈良県", "和歌山県", "鳥取県", "島根県", "岡山県", "広島県", "山口県", "徳島県", "香川県", "愛媛県", "高知県", "福岡県", "佐賀県", "長崎県", "熊本県", "大分県", "宮崎県", "鹿児島県", "沖縄県") population = c(5535, 1392, 1352, 2340, 1108, 1188, 2052, 2964, 2011, 2012, 7113, 6122, 12838, 8917, 2391, 1101, 1168, 812, 871, 2171, 2100, 3800, 7403, 1875, 1402, 2629, 8806, 5586, 1404, 1012, 595, 725, 1948, 2869, 1463, 794, 1003, 1444, 773, 5054, 856, 1440, 1821, 1200, 1136, 1717, 1376)
- グラフ
- ソース
quartz(width=8.267717,height=5.826772) pdata = data.frame(kenmei=kenmei,population=population) gp <- ggplot(pdata) gp <- gp + geom_bar(aes(x=reorder(kenmei,population),weight=population/1000),fill="grey",colour="black") gp <- gp + scale_y_continuous(breaks=population) gp <- gp + labs(y=NULL, x=NULL) p <- seq(0,12,2) s = sum(population) / 1000 t = seq(0,10,2) gp <- gp + geom_linerange(aes(x=0,ymin=0,ymax=max(population)/1000),colour="grey50") gp <- gp + geom_segment(aes(x=0,y=p,xend=-1,yend=p)) gp <- gp + geom_text(aes(x=0,y=p,label=p),vjust=2) gp <- gp + geom_linerange(aes(x=48,ymin=0,ymax=s*max(t)/100),colour="grey50") gp <- gp + geom_segment(aes(x=48,y=s*t/100,xend=49,yend=s*t/100)) gp <- gp + geom_text(aes(x=48,y=s*t/100,label=paste(t,"%",sep="")),vjust=-1,hjust=0.2) gp <- gp + geom_text(aes(x=-6,y=s*max(t)/100/2,label="人口(百万人)")) gp <- gp + geom_text(aes(x=54,y=s*max(t)/100/2,label="人口の割合")) gp <- gp + mytheme(base_size=8) gp <- gp + opts(axis.line=theme_blank()) gp <- gp + coord_flip(ylim=c(-0.2,14)) print(gp) grid.gedit("text", gp=gpar(fontfamily="HiraMaruProN-W4"))
国立大学運営費交付金
- データ
year = 2004:2011 money = c(12415, 12317, 12214, 12043, 11813, 11695, 11585, 11528)
- グラフ
- ソース
quartz(width=8.267717,height=5.826772) mdata = data.frame(year=year,money=money) gm <- ggplot(mdata) gm <- gm + geom_bar(aes(x=as.character(year),y=money),fill="grey",colour="black") gm <- gm + geom_text(aes(x=as.character(year),y=money,label=money), vjust=-0.5) gm <- gm + mytheme(title="国立大学法人運営費交付金予算",base_size=14) gm <- gm + labs(x=NULL,y="億円") gm <- gm + coord_cartesian(ylim=c(0,14000)) gm grid.gedit("text", gp=gpar(fontfamily="HiraMaruProN-W4"))
- 折れ線バージョン
- ソース
quartz(width=8.267717,height=5.826772) gm <- ggplot(mdata) gm <- gm + geom_point(aes(x=year,y=money),size=3) gm <- gm + geom_line(aes(x=year,y=money)) gm <- gm + mytheme(title="国立大学法人運営費交付金予算") gm <- gm + labs(x=NULL,y="億円") gm grid.gedit("text", gp=gpar(fontfamily="HiraMaruProN-W4"))
交通事故死者数
- データ
year = 1995:2009 death = c(10679, 9942, 9640, 9211, 9006, 9066, 8747, 8326, 7702, 7358, 6871, 6352, 5744, 5155, 4914)
- グラフ
- ソース
quartz(width=8.267717,height=5.826772) ddata <- data.frame(year=year,death=death) gd <- ggplot(ddata) gd <- gd + geom_bar(aes(x=as.character(year),y=death),fill=cCyan,colour="black") gd <- gd + scale_x_discrete(breaks=year,labels=substr(year,3,4)) gd <- gd + labs(x=NULL,y="人") gd <- gd + mytheme(base_size=20,margin.top=3,margin.side=1,title="交通事故死者数") gd <- gd + coord_cartesian(ylim=c(0,12000)) gd
- 折れ線バージョン
- ソース
quartz(width=8.267717,height=5.826772) gd <- ggplot(ddata) gd <- gd + geom_line(data=data.frame(year=c(1970,1995),death=c(16765,10679)),aes(x=year,y=death),colour="grey",linetype=2) gd <- gd + geom_point(data=data.frame(year=1970,death=16765),aes(x=year,y=death),size=4) gd <- gd + geom_point(aes(x=year,y=death),size=4) gd <- gd + geom_line(aes(x=year,y=death)) gd <- gd + mytheme(20) gd <- gd + opts(title="交通事故死者数") gd <- gd + labs(x=NULL,y="人") gd <- gd + scale_x_continuous(breaks=c(1970, 1995, 2000, 2005, 2009)) print(gd)
所得の分布
- データ
income=c(6.2,11.7,12.9,13.2,10.6,9.2,7.8,6.3,4.9,4.2,2.9,2.2,1.9,1.3,1,0.7,0.6,0.4,0.4,0.2,1.4)
- グラフ
- ソース
t=c(0:20) idata <- data.frame(income=income,t=t,it=as.character(t)) quartz(width=8.267717,height=5.826772) gi <- ggplot(idata) gi <- gi + geom_rect(aes(xmin=t,xmax=t+1,ymin=0,ymax=income),colour="black",fill="grey90") gi <- gi + geom_text(aes(x=t,y=income, label=paste(income,"%",sep="")),vjust=-0.4,hjust=-0.2,size=4) gi <- gi + geom_text(aes(x=t, y=0, label=paste(seq(0,2000,100),"万",sep="")),hjust=1.1,size=4) gi <- gi + geom_linerange(aes(x=5.668,ymin=0,ymax=1)) gi <- gi + geom_text(aes(x=5.668, y=1, label="平均値566.8万円"),hjust=0,size=3) gi <- gi + geom_linerange(aes(x=4.51,ymin=0,ymax=1)) gi <- gi + geom_text(aes(x=4.51, y=1, label="中央値451万円"),hjust=0,size=3) gi <- gi + scale_x_discrete(breaks=t) gi <- gi + scale_y_continuous(breaks=NULL) gi <- gi + mytheme() gi <- gi + labs(y=NULL, x=NULL) gi <- gi + opts(title="2006年 所得分布",axis.line=theme_blank(),axis.ticks=theme_blank(),axis.text.x=theme_blank()) gi <- gi + coord_flip(ylim=c(-2,16)) gi grid.gedit("text", gp=gpar(fontfamily="HiraKaku"))
賃金の分布
- データ
salary = c(0,100,120,140,160,180,200,220,240,260,280,300, 320,340,360,400,450,500,600,700,800,900,1000,1200) rate = c(0.2,0.5,1.3,2.6,4.4,5.6,7.5,7.6,7.6,6.9,6.4,6.2, 5.4,4.8,8.1,7.6,5.2,6.2,3.0,1.4,0.7,0.3,0.3,0.2) range = c(salary[2:24],1400)-salary
- グラフ
- ソース
quartz(width=8.267717,height=5.826772) sdata <- data.frame(salary=salary, rate=rate, range=range) t = c(0,100,200,300,360,400,450,500,600,700,800,900,1000,1200) gs <- ggplot(sdata) gs <- gs + geom_rect(aes(xmin=salary,xmax=salary+range,ymin=0,ymax=rate/range),fill="grey",colour="black") gs <- gs + geom_text(aes(x=salary+range/2,y=rate/range,label=paste(rate,"%","")),vjust=0.4, hjust=-0.3,size=2) gs <- gs + scale_x_continuous(breaks=t,labels=paste(t/10,"万",sep="")) gs <- gs + mytheme() gs <- gs + opts(axis.line=theme_blank(),axis.ticks=theme_blank(),axis.text.x=theme_blank()) gs <- gs + labs(y=NULL, x=NULL) gs <- gs + coord_flip(ylim=c(0,0.5)) print(gs) grid.gedit("text", gp=gpar(fontfamily="HiraKaku"))
アンケート
- データ
select = c("千倍","一万倍","十万倍","百万倍","千万倍","わからない") value = c(18,12,21,21,17,12)
- グラフ
- ソース
t <- c(6:1) tdata <- data.frame(select=select, value=value, t=t) quartz(width=8.267717,height=5.826772) gt <- ggplot(tdata) gt <- gt + geom_bar(aes(x=as.character(t),y=value),colour="black",fill="grey") gt <- gt + geom_text(aes(x=t,y=value,label=paste(value,"%",sep="")),hjust=-0.5) gt <- gt + mytheme() gt <- gt + opts(title="兆は百万の何倍?",axis.line=theme_blank(),axis.ticks=theme_blank(),axis.text.x=theme_blank()) gt <- gt + scale_x_discrete(breaks=t,labels=select) gt <- gt + labs(x=NULL, y=NULL) gt <- gt + coord_flip(ylim=c(0,25)) print(gt)
アンケート(複数回答)
- データ
製品サービス=c("パソコン","ファッション","携帯音楽プレーヤー","通信機器","国内旅行","音楽","書籍","アニメ・漫画","ゲーム","外食・食べ歩き","映画","カメラ","海外旅行","テレビ","語学、資格試験","化粧品、エステ","自動車") 割合=c(62.1, 53.9, 50.6, 49.9, 44.0, 43.7, 42.9, 42.0, 38.4, 37.6, 35.5, 35.0, 33.9, 28.8, 27.3, 26.2, 22.8)
- グラフ
- ソース
pdata <- data.frame(product=製品サービス,rate=割合) quartz(width=8.267717,height=5.826772) gp <- ggplot(pdata) gp <- gp + geom_bar(aes(x=reorder(product,rate),y=rate),fill="grey",colour="black") gp <- gp + geom_text(aes(y=rate, x=product, label=paste(割合,"%",sep="")),hjust=-0.2) gp <- gp + mytheme(title="大学生の興味関心がある製品・サービスランキング") gp <- gp + opts(axis.line=theme_blank(),axis.text.x=theme_blank(),axis.ticks=theme_blank()) gp <- gp + labs(x=NULL,y=NULL) gp <- gp + coord_flip(ylim=c(0,75)) gp
積み重ね棒グラフ
- データ
ここで扱うデータはグラフの例:積み重ね棒グラフのデータをcsv形式でDataフォルダに保存してあるとする。
X = read.csv(file("Data/highschool_info.csv",encoding="cp932"),header=T) X = cbind(X, data.frame(教えていない=100-X[,2]-X[,3], ord=X[,2]+X[,3]))
- グラフ
- ソース
X.melt <- melt.data.frame(X,id.vars=c("X","ord"),variable_name="category",na.rm=T) quartz(width=8.267717,height=5.826772) gx <- ggplot(X.melt) gx <- gx + geom_bar(aes(x=reorder(X,ord),y=value,fill=category),colour="black",stat="identity") z = o[length(o)] gx <- gx + geom_text(aes(y=X.melt[z,4]/2, label="教えている", x=25)) gx <- gx + geom_text(aes(label="一部教えている", y=X.melt[z,4]+X.melt[z+length(o),4]/2, x=25)) gx <- gx + labs(x=NULL,y=NULL) gx <- gx + mytheme() gx <- gx + opts(legend.position="none",axis.line=theme_blank(),axis.text.x=theme_blank(),axis.ticks=theme_blank()) gx <- gx + scale_fill_grey() gx <- gx + coord_flip(ylim=c(0,100)) gx grid.gedit("text", gp=gpar(fontfamily="HiraKaku"))
積み重ね棒グラフ2
- データ
A = c(55.5, 17, 9.3, 5.7) B = c(6.4, 4.9, 7.4, 2.6) C = c(9.2, 4.8, 10, 3.5)
- グラフ
- ソース
quartz(width=8.267717,height=5.826772) edata <- data.frame(id=rep(1:4,1),A=A,B=B,C=C) edata.melt <- melt.data.frame(edata,id.vars="id",variable_name="category") ge <- ggplot(edata.melt) ge <- ge + geom_bar(aes(x=category,weight=value,fill=factor(id)),colour="black") gval <- cumsum(A)-A/2 ge <- ge + geom_text(aes(x="A",y=gval,label=c("1年次", "2年次", "3年次", "単位制"),colour=factor(id))) ge <- ge + scale_colour_grey(start=0.8,end=0.2) ge <- ge + scale_fill_grey() ge <- ge + scale_x_discrete(breaks=c("A","B","C"),labels=c("情報A","情報B","情報C")) ge <- ge + labs(x=NULL,y=NULL) ge <- ge + mytheme() ge <- ge + opts(legend.position="none") ge <- ge + coord_cartesian(ylim=c(0,100)) ge grid.gedit("text", gp=gpar(fontfamily="HiraKaku"))
迷惑メールの数
- データ
ここで扱うデータはグラフの例:迷惑メールの数のデータをDataフォルダに保存してあるとする。
chainletters = read.csv("Data/chainletters.csv", as.is=TRUE, fileEncoding="SJIS", comment.char="#") t = as.POSIXct(chainletters$期間)
- グラフ
- ソース
quartz(width=8.267717,height=5.826772) chainletters$期間 = as.POSIXct(chainletters$期間) gc <- ggplot(chainletters) gc <- gc + geom_bar(aes(x=期間+3.5*24*60*60,weight=件数),binwidth=7*24*60*60,fill=cCyan,colour="white") gc <- gc + labs(x=NULL,y=NULL) gc <- gc + mytheme() r <- range(chainletters$期間) gc <- gc + scale_x_datetime(major="2 months", format="%m月",limits=c(r[1],r[2]+3.5*24*60*60)) gc <- gc + opts(title="...チェーンメールの転送数") gc <- gc + coord_cartesian(ylim=c(0,12000)) gc
折れ線グラフ
地球温暖化
- データ
気温 = c(-0.49, -0.56, -0.6, -0.56, -0.53, -0.32, -0.34, -0.51, -0.41, -0.34, -0.43, -0.55, -0.62, -0.69, -0.55, -0.45, -0.63, -0.67, -0.67, -0.64, -0.67, -0.58, -0.55, -0.38, -0.28, -0.49, -0.56, -0.4, -0.43, -0.36, -0.28, -0.41, -0.39, -0.41, -0.31, -0.22, -0.32, -0.33, -0.45, -0.23, -0.2, -0.23, -0.38, -0.23, -0.31, -0.33, -0.22, -0.19, -0.22, -0.17, -0.11, -0.12, -0.08, 0.03, -0.11, -0.26, -0.28, -0.26, -0.27, -0.34, -0.21, -0.15, -0.08, -0.31, -0.32, -0.41, -0.14, -0.08, -0.14, -0.18, -0.09, -0.07, -0.04, -0.34, -0.28, -0.21, -0.21, -0.23, -0.12, -0.15, -0.26, -0.14, -0.02, -0.29, -0.24, -0.33, -0.04, -0.13, -0.01, 0.02, 0.06, -0.06, 0.09, -0.09, -0.11, -0.02, 0.14, 0.12, 0.05, 0.19, 0.12, -0.02, 0.01, 0.08, 0.16, 0.06, 0.24, 0.37, 0.15, 0.15, 0.27, 0.31, 0.31, 0.27, 0.32, 0.31, 0.28, 0.2, 0.31)
- グラフ
- ソース
quartz(width=11, height=3.3) tdata <- data.frame(time=1891:2009,Temp=気温) gt <- ggplot(tdata) gt <- gt + geom_line(aes(x=time,y=Temp)) gt <- gt + geom_point(aes(x=time,y=Temp)) gt <- gt + mytheme(title="地球の平均気温の変化(単位:℃,相対値)") gt <- gt + opts(panel.border=theme_rect(colour="black")) gt <- gt + labs(x=NULL,y=NULL) gt <- gt + scale_x_continuous(breaks=c(1891, seq(1900,2000,20), 2009)) gt
男女別睡眠時間の推移
- データ
睡眠時間 = data.frame( 年=seq(1986,2006,5), 男=c(7+56/60,7+50/60,7+52/60,7+49/60,7+47/60), 女=c(7+39/60,7+34/60,7+36/60,7+35/60,7+32/60))
- グラフ
- ソース
quartz(width=4.245817,height=5.926181) # Mac sleep <- melt.data.frame(睡眠時間, id.vars="年",variable_name="sex") gs <- ggplot(sleep,aes(x=年,y=value)) gs <- gs + geom_line(aes(colour=sex)) + geom_point(aes(colour=sex)) gs <- gs + scale_colour_manual(aes(sex), value=qcolours) gs <- gs + mytheme(title="15歳以上の日本人の睡眠時間") gs <- gs + opts(legend.position="none") gs <- gs + labs(x=NULL,y="時間") t = seq(7.5, 8, 1/6) gs <- gs + scale_x_continuous(breaks=(sleep$年)) gs <- gs + scale_y_continuous(limit=c(7.5,8),breaks=t,labels=c("7:30", "7:40", "7:50", "8:00")) gs <- gs + geom_text(aes(x=1996,y=value[年==1996],label=sex[年==1996]),vjust=-0.5) gs <- gs + geom_text(aes(x=2006,y=value[年==2006],label=c("7:47", "7:32")),hjust=1,vjust=1.5) gs grid.gedit("text", gp=gpar(fontfamily="HiraKaku"))
パソコン世帯普及率
- データ
- グラフ
- ソース
パソコン世帯普及率(内閣府2009年)
- データ
- グラフ
- ソース
出生性比
- データ
- グラフ
- ソース
出生率
- データ
- グラフ
- ソース
生まれかわり
- データ
- グラフ
- ソース
Twitterのフォロワー数
- データ
- グラフ
- ソース
白血病による死亡数の推移
- データ
- グラフ
- ソース
ストリップチャート・ボックスプロット
- データ
- グラフ
- ソース
Michelson-Morley の実験
- データ
- グラフ
- ソース
(Clevelandの)ドットプロット
都道府県別人口(ドットプロット)
- データ
- グラフ
- ソース
ドットプロット
- データ
- グラフ
- ソース
分位数プロット(quantile plot)
分位数プロット
- データ
- グラフ
- ソース
散布図
都道府県別人口・面積
- データ
- グラフ
- ソース
散布図(対話型)
- データ
- グラフ
- ソース
その他
高校数学のグラフ
- データ
- グラフ
- ソース
まとめ
家計簿を CSV ファイルで記入して、R で加工して、ggplot2 で表示
背景
家計簿をつけることは、自分の経済状況を把握する上で、とても重要な指標になる。家計簿をつけることができる人間は、自己管理や忍耐力などのさまざまな面で評価される。しかしながら、私にとって「家計簿をつける」ことは非常に困難だ。だって面倒なんだもん。
通常の家計簿では、費目(品名など)や用途(消耗品、嗜好品など)なんかで分けて、月ごとに合計出して・・・なんてやるわけです。こんなの面倒すぎて、やってられない。菓子パンは食料品か嗜好品か?なんてことで悩みたくない。つーか、そんなに詳細につけたところで、意味があるのか?後で見直して、「あー、先月は嗜好品がちょっと多かったなぁ。今月は抑えるか。」なんてことになるのか?なる人は立派です。ていうかそういう人は家計簿つけれないとかで悩まないんだろう。私は悩む。家計簿をつけたい!でも面倒。どうにか簡単に楽しくできないものか。
目的
家計簿を、出来る限り有益な情報を残しつつ、簡単につけることができる方法を模索する。
思考
家計簿の意味は、
- 収入と出費を明確にすることで、現状を把握しコントロールする
- 過去から現在までの傾向を探ることで、将来的な予測を行うことができる
といったところか。
1.に関しては、金銭の動きだけを記すことで事足りる。
2.に関しては、何に出費したのか、その目的はなんだったのか、といった情報もいくらか盛り込まないといけないだろう。つまり、家計簿で費目を分けて細かく記述する意味は、将来予測のためである。となるともちろん、統計的な知識が必要になる。逆に言えば、どんなに細かい情報を残していたとしても、それを分析する力がなければ意味が無い(それにこういうデータは分析者が欲しい情報とは異なることが多いのだ)。以上のことをふまえて、どこまで細かくつけるか、ではなく、どういった予測が行いたいのか、に注目することで、記述法が見えてきた。
私が知りたい予測は、何にいくら使いそうか、なんてことじゃない。そんなのは大体変わらないし、変わるとしても計画的に購入しているから問題ない。ここで知りたいのは、「どこで使いそうか」だ。つまり、コンビニで弁当を買うのとスーパーで買うのとでは、後者のほうが明らかに安い(前者が明らかにおいしい)。買うもの自体は変わらないのに、買う場所によって金額が違うのだ。つまり、家計簿によって、どこで出費する傾向が強いかが分かれば、その場所に行くことを制限する抑止力として働き、結果として利益につながるはずだ。
実験
記述する項目は、時間、場所、金額の3点にする。こうすると、レシート1枚が一つのデータセットになる。記述するファイルは何でも良いけど、ここでは CSV ファイル(カンマ区切りのデータ)とする。つまり、
datetime | place | expense |
---|---|---|
2012-01-05 03:51:00 | A店 | 1240 |
2012-01-07 20:26:00 | G店 | 1413 |
2012-01-05 23:07:00 | B店 | 440 |
2012-01-05 23:21:00 | A店 | 548 |
2011-12-19 15:48:00 | E店 | 438 |
2012-01-02 22:54:00 | A店 | 557 |
2012-01-07 05:09:00 | A店 | 1341 |
2012-01-07 20:29:00 | B店 | 480 |
... | ... | ... |
みたいな感じ。データは決して自分で整理せず、あくまでレシート内容を1行に書くに留める。整理は EXCEL なんかだと煩雑になるので、R で行うことにする(趣味の問題か)。
まずはデータの読み込み。
options(encoding="SJIS") cost <- read.csv("HouseholdAccountBook.csv",header=T)
これで、cost にデータフレームとして読み込まれる。
次に、時間を計算するために数値として変換する。
cost$datetime <- as.POSIXct(cost$datetime,'%Y-%m-%d %H:%M:%S') # 時間文字列を数値として扱うために変換 cost <- cost[order(cost$datetime),] # 時間順に昇順ソート cost <- cbind(cost, data.frame(month=format(cost$datetime,"%Y年%m月"),day=format(cost$datetime,"%d"))) # データに月と日のカテゴリ変数を追加
さらに、月別の累積金額を追記しておく。
cum <- by(cost$expense,cost$month,cumsum) # 月ごとの累積金額 cum.d <- data.frame() for(c in cum){ # 累積金額をデータフレームに cum.d <- rbind(cum.d, data.frame(cum.expense=c)) } cost <- cbind(cost,cum.d) # 元データに結合
また、月別の合計金額をグラフ中にテキストで表示するために準備。
cost.cum <- as.data.frame(xtabs(expense~month, cost)) # 月別合計金額 colnames(cost.cum) <- c("month","cum.expense") # 列名を元データに合わせる cost.cum <- merge(cost,cost.cum) # 元データとマージ(日時を付加するため)
準備完了。いよいよ ggplot2 でグラフ化する。
g <- ggplot(cost) # 元データ g <- g + geom_bar(aes(x=datetime,weight=expense,group=place,fill=place),colour="grey90",binwidth=1*24*60*60) # 横軸に日時、縦軸に金額、場所ごとに色分け、幅は1日ごとに g <- g + geom_point(aes(x=datetime,y=cum.expense),colour=cCyan,shape=1,size=3) # 累積金額をポイントで g <- g + geom_line(aes(x=datetime,y=cum.expense),colour=cCyan) # ラインで g <- g + geom_text(data=cost.cum,aes(x=datetime,y=cum.expense,label=cum.expense),hjust=1.2,vjust=0.5) # 月別合計金額を最後の点の横に記述 g <- g + geom_smooth(aes(x=datetime,y=cum.expense)) # 近似曲線 g <- g + scale_x_datetime(major="1 week", format="%b%d") # 横軸を週刻みに g <- g + facet_grid(.~month,scales="free") # 月別にグラフを分ける g <- g + opts(title=sprintf("家計簿")) # グラフタイトル g <- g + labs(x="日付",y="出費") # 軸名 g grid.gedit("text", gp=gpar(fontfamily="HiraMaruProN-W4")) # 日本語に対応するため(Mac以外の場合はfontfamilyをいじる必要がある)
出来た図がこれ。
なかなかいい感じ。累積金額が直線的に伸びているのが分かるし、どこで購入しているかも分かりやすい。
次に、場所ごとの合計金額を月別に表示してみよう。まずはデータを加工する。
each.cost <- as.data.frame(xtabs(expense~place+month,cost)) # 場所別の月別合計(その月にどこでいくら使ったか) each.cum <- by(each.cost$Freq,each.cost$month,cumsum) # 場所別にしたときの累積(後でテキストで記述するため) each.cum.d <- data.frame() for(c in each.cum){ # 累積金額をデータフレームに each.cum.d <- rbind(each.cum.d, data.frame(cum.expense=c)) } each.cost <- cbind(each.cost,each.cum.d) # 場所別の月別合計に結合
さて、図示。
g <- ggplot(each.cost) g <- g + geom_bar(aes(x=month,weight=Freq,fill=place,colour=place),colour="grey90") # 場所別で積み重ねる g <- g + geom_text(aes(x=month,y=cum.expense-Freq/2,label=paste(place,"=",Freq,sep=""),group=month),position=position_jitter(),size=4) # 場所別の合計金額をグラフ内に記述 g <- g + opts(title=sprintf("家計簿(場所別)")) # タイトル g <- g + labs(x="月",y="出費(累積)") # 軸名 g grid.gedit("text", gp=gpar(fontfamily="HiraMaruProN-W4")) # 日本語用
A店での出費が多いなぁ。なんてことが分かりやすい。今後は CSV データを記入していくだけで、R が図にしてくれる。もっと詳細な分析がしたかったら、そのまま R の関数に当てはめることが可能だ。