ggplot2

棒グラフ01(家計調査)

ggplot2, plotflowパッケージ

barplot関数、plot(type=”h”)、ggplot2::geom_bar の３通りの方法で棒グラフを作成。

(データ)
家計調査（家計収支編）　時系列データ（二人以上の世帯）

  1. 長期時系列データ（年）
    18-2　1世帯当たり年平均1か月間の収入と支出-二人以上の世帯うち勤労者世帯（平成12年～27年）（全国）（エクセル：74KB）より

データの読み込み、指数表記の回避:options(scipen=10)

1
2
3
4
Year<-c("2000","2001","2002","2003","2004","2005","2006","2007","2008","2009","2010","2011","2012","2013","2014","2015")
消費支出<-c(341896,336209,331199,326566,331636,329499,320231,323459,324929,319060,318315,308838,313874,319170,318755,315379)
# scipenによって指数表記を回避
options(scipen=10)

普通の棒グラフ

barplot 関数
1
2
3
4
#png("bar01.png",width=1000,height=800)
barplot(消費支出,names.arg=Year,col="lightblue",las=1)
title("1世帯当たり年平均1か月間の消費支出")
#dev.off()

plot (type=”h”,lend=”butt” (またはlend=1) )
  • lend=1 で棒の上部を平らにする。
  • yaxs=”i” でy=0からx軸までの余白を消す。
1
2
3
4
5
#png("bar02.png",width=1000,height=800)
plot(1:length(消費支出),消費支出,col="lightblue",las=1,type="h",lend=1,lwd=30,xaxt="n",xlab="",ylab="",ylim=c(0,max(消費支出)),yaxs="i")
axis(1, at=1:length(Year), labels=Year) 
title("1世帯当たり年平均1か月間の消費支出")
#dev.off()

ggplot2
1
2
3
4
5
6
7
8
9
library(ggplot2)
df<-data.frame(Year,消費支出)
#options(scipen=10)
g <- ggplot(df,aes (x =Year,y =消費支出 ))
g <- g + geom_bar(stat = "identity",colour="gray50",fill="lightblue")
g <- g + labs(x="",y="",title="1世帯当たり年平均1か月間の消費支出")
#png("bar03.png",width=1000,height=800)
g
#dev.off()

少し手を加える(y=0からx軸までの余白を消す等)

1
2
3
4
5
6
g <- g + theme_bw()
#g <- g + scale_y_continuous(expand = c(0,0),limits=c(0,NA))
g <- g + scale_y_continuous(expand =c(0,0),limits=c(0,max(df$消費支出)*1.1),breaks = c(0,100000,200000,300000),labels = c("0","100,000", "200,000", "300,000")) 
#png("bar04.png",width=1000,height=800)
g
#dev.off()

棒グラフにy軸が共通な折れ線グラフを加える

barplot 関数
  • barplot の返り値を利用する
1
2
3
4
5
6
7
8
9
10
11
12
#折れ線グラフのデータは可処分所得
可処分所得<-c(474411,466003,453716,440667,446288,441156,441448,442504,442749,427912,429967,420538,425005,426132,423541,427270)
# 可処分所得 > 消費支出 だから、 ylim=c(0,max(可処分所得)*1.01) とする
#png("bar05.png",width=1000,height=800)
#各barの中心のx座標を得る
b<-barplot(消費支出,names.arg=Year,col="lightblue",las=1,ylim=c(0,max(可処分所得)*1.01))
#
lines(b,可処分所得,col="red")
points(b,可処分所得,col="red",pch=20,cex=1.5)
text(length(可処分所得)/2 , min(可処分所得),"可処分所得",pos=1,cex =1.2,col="red")
title("1世帯当たり年平均１か月間の消費支出")
#dev.off()

plot (type=”h”,lend=”butt” (またはlend=1) )
1
2
3
4
5
6
7
8
9
10
11
12
#折れ線グラフのデータは非消費支出
非消費支出<-c(88343,86732,86208,84143,85402,83429,84271,86257,91486,90314,90725,89611,93501,97457,96221,98398)
#
#png("bar06.png",width=1000,height=800)
plot(1:length(消費支出),消費支出,col="lightgreen",las=1,type="h",lend=1,lwd=30,xaxt="n",xlab="",ylab="",ylim=c(0,max(消費支出)),yaxs="i")
axis(1, at=1:length(消費支出), labels=Year) 
#
lines(1:length(消費支出),非消費支出,col="red")
points(1:length(消費支出),非消費支出,col="red",pch=20,cex=1.5)
text(length(非消費支出)/2 , max(非消費支出),"非消費支出",pos=3,cex =1.2,col="red")
title("1世帯当たり年平均１か月間の消費支出")
#dev.off()

ggplot2
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
#折れ線グラフのデータは直接税、社会保険料
直接税<-c(40189,38096,37422,34967,36968,35851,37428,38800,41963,40878,40116,38954,40228,42205,41462,42091)
社会保険料<-c(48019,48491,48645,49008,48284,47374,46719,47269,49388,49310,50540,50531,53173,55155,54694,56223)
library(ggplot2)
df<-data.frame(Year,消費支出,直接税,社会保険料)
#options(scipen=10)
#
g <- ggplot(data=df) 
g <- g + geom_bar(aes(x =Year,y =消費支出),stat = "identity",colour="gray50",fill="lightblue")
# 直接税
g <- g + geom_line(aes(x =1:nrow(df),y =直接税),stat="identity",colour="red")
g <- g + geom_point(aes(x =1:nrow(df),y =直接税),stat="identity",colour="red",size=2)
g <- g + geom_text(aes(x =nrow(df)/2,y =min(df$直接税)),label="直接税",colour="red",size=6, family = "serif", vjust=1.5)
# 社会保険料
g <- g + geom_line(aes(x =1:nrow(df),y =社会保険料),stat = "identity",colour="blue")
g <- g + geom_point(aes(x =1:nrow(df),y =社会保険料),stat = "identity",colour="blue",size=2)
g <- g + geom_text(aes(x =nrow(df)/2,y =max(df$社会保険料)),label="社会保険料",colour="blue",size=6, family = "serif", vjust=-0.1)
#
g <- g + labs(x="",y="",title="1世帯当たり年平均1か月間の消費支出")
g <- g + theme_bw()
#g <- g + scale_y_continuous(expand = c(0,0),limits=c(0,NA))
g <- g + scale_y_continuous(expand =c(0,0),limits=c(0,max(df$消費支出)*1.1),breaks = c(0,100000,200000,300000),labels = c("0","100,000", "200,000", "300,000")) 
g <- g + theme(text=element_text(size=12,family="TakaoExMincho"))
#png("bar07.png",width=1000,height=800)
g
#dev.off()

棒グラフのy軸とは異なる軸の折れ線グラフを加える（２軸）

折れ線グラフのデータはエンゲル係数（作成するグラフすべて）

1
2
#データを読み込む
エンゲル係数<-c(22.0,21.9,22.2,21.9,21.7,21.5,21.7,21.7,21.9,22.0,21.9,22.2,22.1,22.1,22.3,23.6)
barplot 関数
1
2
3
4
5
6
7
8
9
10
#png("bar08.png",width=1000,height=800)
par(mar=c(5,5,3,5))
b<-barplot(消費支出,names.arg=Year,col="lightblue",las=1,xlim=c(0.5,length(消費支出)+3))
title("1世帯当たり年平均1か月間の消費支出",cex.main=1.5)
par(new=TRUE)
plot(x=b,y=エンゲル係数,type="o",col="red",lwd=2,pch=20,cex=1,ylim=c(0,50),xaxt="n",yaxt="n",xlab="",ylab="",bty="n",yaxs="i",xlim=c(0.5,length(消費支出)+3))
axis(4,las=1)
text(max(b)/2 , max(エンゲル係数),"エンゲル係数",pos=3,cex =1.2,col="red")
mtext("エンゲル係数 （％）",4,2)
#dev.off()

plot (type=”h”,lend=”butt” (またはlend=1) )
1
2
3
4
5
6
7
8
9
10
11
#png("bar09.png",width=1000,height=800)
par(mar=c(5,5,3,5))
plot(1:length(消費支出),消費支出,col="lightgreen",las=1,type="h",lend=1,lwd=30,xaxt="n",xlab="",ylab="",ylim=c(0,max(消費支出)*1.1),yaxs="i")
axis(1, at=1:length(消費支出), labels=Year) 
title("1世帯当たり年平均1か月間の消費支出",cex.main=1.5)
par(new=TRUE)
plot(1:length(消費支出),y=エンゲル係数,type="o",col="red",lwd=2,pch=20,cex=1,ylim=c(0,50),xaxt="n",yaxt="n",xlab="",ylab="",bty="n",yaxs="i")
axis(4,las=1)
text(max(b)/2 , max(エンゲル係数),"エンゲル係数",pos=3,cex =1.2,col="red")
mtext("エンゲル係数 （％）",4,2.5)
#dev.off()

ggplot2

(参考)
Rで解析：ggplot2の利便性が向上「plotflow」パッケージ 

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
#devtools::install_github("trinker/plotflow")
library(plotflow)
df<-data.frame(Year,消費支出,エンゲル係数)
twoplot <- ggplot(df,aes(x = Year))
#棒グラフ
g1 <- twoplot + geom_bar(aes(y = 消費支出),stat = "identity", fill = "lightblue") + theme_bw() +
theme(plot.margin = grid::unit(c(.5, 1, .5, .5), "cm")) +
labs(x = "", y = "消費支出",title="1世帯当たり年平均1か月間の消費支出")
#折れ線グラフ
g2 <- twoplot + geom_line(aes(x=1:nrow(df),y = エンゲル係数), color = "#4b61ba", size = 2) + theme_classic() +
theme(plot.margin = grid::unit(c(.5, 1, .5, .5), "cm")) + ylim(0, 50) +
geom_point(aes(x=1:nrow(df),y = エンゲル係数), color = "#4b61ba", size =4)+
geom_text(aes(x =nrow(df)/2,y =max(df$エンゲル係数)),label="エンゲル係数",colour="#4b61ba",size=6, family = "serif", vjust=-0.1) +
labs(x = "", y = "エンゲル係数(％)",title="")
#プロット
#png("bar10.png",width=1000,height=800)
ggdual_axis(lhs = g1, rhs = g2)
#dev.off()