R

21世紀の資本グラフ0

Quandl、xts、lattice、latticeExtra、ggplot2、knitr パッケージ

「21世紀の資本」のデータが公開されてるのでRを使ってグラフ化してみます。
（グラフもすでに公開されているのであまり意味はありません。）
（参考）
Piketty Codes
『21世紀の資本』日本語版サポートページ 

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
library(xts)
library(Quandl)
TSI_1<-Quandl("PIKETTY/TSI_1")
#時系列順に並べ替え
#xts クラスに変換するなら並べ替えの必要なし。
sortlist <- order(TSI_1[,1])
dat <- TSI_1[sortlist,]
TSI_1<-dat
rownames(TSI_1) <- c(1:nrow(TSI_1))
#保存
#save(TSI_1,file="TSI_1.dat")
#読み込み
#load("TSI_1.dat")
#xts classに変換
#TSI_1.xts <- as.xts(zoo(TSI_1[,-1]), as.POSIXct(TSI_1[,1]))
TSI_1.xts <- as.xts(read.zoo(TSI_1))
#plot.zoo(TSI_1.xts,xlab="year",ylab="",main="米国におけるトップ十分位の所得シェア(キャピタルゲイン含む) 1910-2010年",lwd=2,las=1)
library(lattice)
#png("Piketty0_1.png",width=1000,height=800)
xyplot(TSI_1.xts,main="米国におけるトップ十分位の所得シェア(キャピタルゲイン含む) 1910-2010年",lwd=2,col="blue",grid = TRUE, scales = list( y = list( rot = 0 )))
#dev.off()

ggplot2パッケージを使うと

1
2
3
4
5
library(ggplot2)
#library(reshape2)
#TSI_2.melt <- melt(data = TSI_2, id.vars=c('Date'), measure.vars=c('France','Britain','Germany'))
ggplot(TSI_1, aes(x=as.Date(Date),y=Value)) + geom_line(size =1.5,linetype=1,alpha =0.8) + 
labs(x="年", y="", title="米国におけるトップ十分位の所得シェア(キャピタルゲイン含む) 1910-2010年")

グラフは省略

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
library(xts)
library(Quandl)
TSI_2<-Quandl("PIKETTY/TSI_2")
#時系列順に並べ替え
sortlist <- order(TSI_2[,1])
( dat <- TSI_2[sortlist,] )
Date<-dat[,1]
#並べ替え(凡例をわかりやすくするため)
d0<-dat[,-1]
TSI_2<-data.frame(Date,d0[order(d0[nrow(d0),], decreasing = TRUE)])
rownames(TSI_2) <- c(1:nrow(TSI_2))
#save(TSI_2,file="TSI_2.dat")
#load("TSI_2.dat")
#表を表示
library(knitr)
#kable(TSI_2)
kable(data.frame(Date=seq(1870,2010,by=10),TSI_2[,-1]))
Date France Britain Germany
1870 699.2606 696.1611 643.8988
1880 732.8977 636.7099 644.3348
1890 726.4028 609.2323 592.3051
1900 726.1795 649.9294 611.2386
1910 699.4556 672.5313 604.2470
1920 330.0902 441.2806 259.1278
1930 343.8186 507.9650 306.8955
1940 317.2543 399.0266 266.4139
1950 218.5893 312.7889 165.6535
1960 279.7374 312.8338 209.3342
1970 311.4872 314.4080 229.4364
1980 320.4479 350.3478 284.4778
1990 341.3831 428.2104 313.4487
2000 474.2294 495.5841 376.6189
2010 574.5578 521.8760 411.6648 
1
2
3
4
5
6
7
#xts classに変換
TSI_2.xts <- as.xts(read.zoo(TSI_2))
#png("Piketty0_2.png",width=1000,height=800)
par(mar=c(5,5,5,6),las=1, cex.axis=0.8)
plot.zoo(TSI_2.xts,main="ヨーロッパの資本/所得比率 1870-2010年",plot.type="single",col=1:3,lwd=2,xlab="年",ylab="")
axis(4,TSI_2.xts[nrow(TSI_2.xts),],colnames(TSI_2.xts),col.axis="black" )
#dev.off()

以下はコードのみ(グラフは省略）

lattice パッケージを使う。

最終データを降順に並べ替えているので国名と対応しやすくなっているはずです。

1
2
3
library(lattice)
xyplot(TSI_2.xts,superpose=TRUE,xlab="year",ylab="",main="ヨーロッパの資本/所得比率 1870-2010年",lwd=2,grid = TRUE,
auto.key=list(title="", space = "right", cex=0.8, just = 0.95), scales = list( y = list( rot = 0 )))

latticeExtra パッケージを使う (1)

1
2
3
4
5
library(latticeExtra)
asTheEconomist(
xyplot(TSI_2.xts,superpose=TRUE,xlab="year",ylab="",main="ヨーロッパの資本/所得比率 1870-2010年",lwd=2,grid = TRUE,
auto.key=list(title="", space = "top", cex=0.8, just = 0.95), scales = list( y = list( rot = 0 )))
)

latticeExtra パッケージを使う (2)

1
2
3
4
library(latticeExtra)
xyplot(TSI_2.xts,superpose=TRUE,xlab="year",ylab="",main="ヨーロッパの資本/所得比率 1870-2010年",
lwd=2,scales = list( y = list( rot = 0 )),auto.key=list(title="Country", space = "right", cex=0.8, just = 0.95), 
par.settings = ggplot2like(), axis = axis.grid)

ggplot2パッケージを使う

1
2
3
4
5
library(ggplot2)
library(reshape2)
TSI_2.melt <- melt(data = TSI_2, id.vars=c('Date'), measure.vars=c('France','Britain','Germany'))
ggplot(TSI_2.melt, aes(x=as.Date(Date),y=value,colour=variable,group=variable)) + geom_line(size = 1.5,linetype=1,alpha = 1) + 
labs(x="年", y="", title="ヨーロッパの資本/所得比率 1870-2010年",colour ="Country")