ggplot2

気温:暖冬とGDP:家計最終消費支出

ggplot2,ggfortify,ggrepel,XML,RCurl,gdata パッケージ

(データ)
四半期別GDP速報 統計表一覧（2015年10-12月期 1次速報値）
四半期 増加率　
実質原系列(前年同期比)
から取り出した「家計最終消費支出」

RData : ts クラス

Consumption_of_Households.RData

過去の地域平均気象データ検索から
もっとも人口の多い「東日本:関東甲信、北陸、東海地方」のデータを使用。

家計最終消費支出:実質原系列(前年同期比)

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
27
28
29
30
31
32
33
34
35
36
37
38
library(XML)
library(RCurl)
library(ggplot2)
library(ggfortify)
library(ggrepel)
#家計最終消費支出データの読み込み
load(url("http://statrstart.github.io/data/Consumption_of_Households.RData"))
#確認
Consumption_of_Households
#
#     Qtr1 Qtr2 Qtr3 Qtr4
#1995  0.8  2.4  0.8  2.6
#1996  3.4  2.0  1.8  2.1
#1997  4.0  0.0  0.5 -0.8
#1998 -3.6 -0.2 -0.2  0.3
#1999  1.1  1.8  0.7  0.6
#2000  1.3  0.6  0.0  0.5
#2001  1.3  2.1  1.7  1.4
#2002  0.7  1.1  2.0  1.1
#2003  0.8  0.6 -0.5  0.7
#2004  1.9  1.5  1.5 -0.3
#2005  0.5  1.3  1.6  2.6
#2006  2.0  1.6 -0.1  0.8
#2007  1.0  1.0  1.6  0.5
#2008  0.6 -1.1 -0.9 -2.2
#2009 -3.9 -0.8 -0.6  2.1
#2010  3.7  2.0  3.5  1.6
#2011 -1.1  0.0  0.2  1.1
#2012  3.6  3.2  1.1  0.7
#2013  1.2  1.3  1.9  1.9
#2014  3.8 -2.4 -2.6 -2.0
#2015 -4.1  0.0  0.3 -1.2
#
#棒グラフ
yl<-max(abs(range(Consumption_of_Households)))
#png("CoH2015.png")
autoplot(Consumption_of_Households,ts.geom="bar",ylim = c(-yl,yl))+ggtitle("家計最終消費支出 実質原系列(前年同期比)")
#dev.off()

「【偏差】３ヶ月ごとの値」を取り込む。

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
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
start=1995 ; end=2015
#reg_no:北日本=2 西日本=8 沖縄・奄美=11 東日本=5
reg=5
#空のデータフレームを作成
kion_diff<-read.table(text = "",col.names = c("year","quarter","temp_diff"))
#
for (i in start:end){
#
url = paste0("http://www.data.jma.go.jp/gmd/cpd/cgi-bin/view/hist.php?reg_no=",reg,"&year=",i,"&month=1&kind=1")
#(注意)factorではなくcharacterで取り込む
tables = readHTMLTable(url,stringsAsFactors=FALSE)
#names(tables)
#tables[[3]]
#tables[[5]]
#
kion<-data.frame(year=rep(i,4),quarter=as.character(tables[[3]][c(3,6,9,12),1]),temp_diff=as.numeric(tables[[3]][c(3,6,9,12),2]))
kion_diff<-rbind(kion_diff,kion)
}
#
#確認
head(kion_diff) ; tail(kion_diff)
#
#year quarter temp_diff
#1 1995    1～3      -0.1
#2 1995    4～6      -0.4
#3 1995    7～9       0.3
#4 1995  10～12      -0.7
#5 1996    1～3      -0.5
#6 1996    4～6      -1.0
#   year quarter temp_diff
#79 2014    7～9      -0.1
#80 2014  10～12       0.0
#81 2015    1～3       0.6
#82 2015    4～6       1.0
#83 2015    7～9       0.0
#84 2015  10～12       1.3
#
#ts クラスへ
kion.ts<-ts(kion_diff$temp_diff,start=start,freq=4)
#
#save("kion.ts",file="kion.RData")
#
yl<-max(abs(range(kion.ts)))
#
if (reg==11){
	reg_name=substring(names(tables[2]),6,10)
	}else{
		reg_name=substring(names(tables[2]),6,8)
		}
#png("kionsa_e2015.png")
autoplot(kion.ts,ts.geom="bar",ylim = c(-yl,yl))+
ggtitle(paste0(reg_name,"：平均気温 平年差(℃)"))
#dev.off()

平均気温 平年差(第四四半期)と家計最終消費支出:前年比(第四四半期)の関係

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
#ts クラスの部分集合
#連続した範囲を取り出すなら、
#window(Consumption_of_Households,2010,c(2015,4))
#window(kion.ts,2010,c(2015,4))
#今回は第四四半期を取り出す。cycle()==4
subCoH<-subset(Consumption_of_Households,cycle(Consumption_of_Households)==4)
subkion<-subset(kion.ts,cycle(kion.ts)==4)
#plot(subkion,subCoH)
#今回はggplot2+ggrepelパッケージを使う
dat<-data.frame(time=seq(start,end,1),subkion,subCoH)
#png("kc_e2015.png")
ggplot(data=dat,aes(x=subkion,y=subCoH)) +
geom_point(color="red") +
stat_smooth(method="lm",se=FALSE,size=0.5,alpha =0.5,linetype=1)+
geom_text_repel(aes(x=subkion,y=subCoH,label=time)) +
theme_classic(base_size = 16)+
labs(title=paste0(reg_name,"：平均気温と家計最終消費支出(第四四半期)"),x="平均気温:平年差(第四四半期)",y="家計最終消費支出:前年比(第四四半期)")
#dev.off()

家計最終消費支出は「前年比」
前年、消費支出が多かったらその反動で今年は少なくなる ?
（逆に前年、少なかったら今年は多くなる ? ）

２年続けて回帰直線の下にくるのは珍しい ?

無相関検定

（注意）「相関関係があるだけでは因果関係があるとは断定できず、因果関係の前提に過ぎない」

詳しくは
相関関係と因果関係

それをふまえて、

1
2
3
4
5
6
7
8
9
10
11
12
cor.test(subkion,subCoH, method="pearson") 
#
#	Pearson's product-moment correlation
#
#data:  subkion and subCoH
#t = -2.3182, df = 19, p-value = 0.03174
#alternative hypothesis: true correlation is not equal to 0
#95 percent confidence interval:
# -0.74935176 -0.04750336
#sample estimates:
#      cor 
#-0.469561

p-value=0.03174だから、有意水準５％で帰無仮説は棄却される。
よって「母相関係数は0ではない」
負の相関がある

西日本、北日本、沖縄・奄美

西日本

北日本

沖縄・奄美

可処分所得の推移：家計調査（家計収支編）より

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

  1. 主要項目の季節調整値（月・四半期）
    主要項目の季節調整値-二人以上の世帯のうち勤労者世帯
    実質指数 -> 可処分所得
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
library(gdata)
x<-read.xls("http://www.stat.go.jp/data/kakei/longtime/zuhyou/season-k.xls",sheet=2,skip=9,nrow=64,header=F)
#確認
head(x) ; tail(x)
#
library(zoo)
Nominal_index<-x[,c(4,5,7:22)]
Nominal_index[,1]<-na.locf(Nominal_index[,1])
names(Nominal_index)<-c("Year","Quarter","実収入","経常収入","消費支出","食料","住居","光熱水道","家具家事","被服履物","保健医療","交通通信","教育","教養娯楽","その他","諸雑費","可処分所得","消費性向")
Real_index<-x[,c(4,5,23:36)]
Real_index[,1]<-na.locf(Real_index[,1])
names(Real_index)<-c("Year","Quarter","実収入","経常収入","消費支出","食料","住居","光熱水道","家具家事","被服履物","保健医療","交通通信","教育","教養娯楽","諸雑費","可処分所得")
#確認した期間に start パラメータを合わせること
Real_index.ts<-ts(Real_index[,-c(1,2)],start=2000,freq=4)
#
dataname<-"可処分所得"
data<-Real_index.ts[,dataname]
#png("DIk2015.png")
autoplot(data,ts.geom="line")+ggtitle(paste0(dataname,":実質指数 : 2010年＝100（四半期データ）"))
#dev.off()

1
2
3
4
5
dataname<-c("可処分所得","食料","教育")
data<-Real_index.ts[,dataname]
#png("DIksk2015.png")
autoplot(data,ts.geom="line")+ggtitle("実質指数 : 2010年＝100（四半期データ）")
#dev.off()