『経済・ファイナンスデータの計量時系列分析』章末問題をRで解く－第6章見せかけの回帰と共和分－

<a href="https://www.amazon.co.jp/%E7%B5%8C%E6%B8%88%E3%83%BB%E3%83%95%E3%82%A1%E3%82%A4%E3%83%8A%E3%83%B3%E3%82%B9%E3%83%87%E3%83%BC%E3%82%BF%E3%81%AE%E8%A8%88%E9%87%8F%E6%99%82%E7%B3%BB%E5%88%97%E5%88%86%E6%9E%90-%E7%B5%B1%E8%A8%88%E3%83%A9%E3%82%A4%E3%83%96%E3%83%A9%E3%83%AA%E3%83%BC-%E6%B2%96%E6%9C%AC-%E7%AB%9C%E7%BE%A9/dp/4254127928/ref=as_li_ss_tl?ie=UTF8&qid=1478165293&sr=8-1&keywords=%E7%B5%8C%E6%B8%88%E3%83%BB%E3%83%95%E3%82%A1%E3%82%A4%E3%83%8A%E3%83%B3%E3%82%B9%E3%83%87%E3%83%BC%E3%82%BF%E3%81%AE%E8%A8%88%E9%87%8F%E6%99%82%E7%B3%BB%E5%88%97%E5%88%86%E6%9E%90&linkCode=ll1&tag=aokikenichi-22&linkId=b4fb2bc3209ec5a8b2d381d8955f2486">『経済・ファイナンスデータの計量時系列分析』</a>
<a href="https://www.amazon.co.jp/%E7%B5%8C%E6%B8%88%E3%83%BB%E3%83%95%E3%82%A1%E3%82%A4%E3%83%8A%E3%83%B3%E3%82%B9%E3%83%87%E3%83%BC%E3%82%BF%E3%81%AE%E8%A8%88%E9%87%8F%E6%99%82%E7%B3%BB%E5%88%97%E5%88%86%E6%9E%90-%E7%B5%B1%E8%A8%88%E3%83%A9%E3%82%A4%E3%83%96%E3%83%A9%E3%83%AA%E3%83%BC-%E6%B2%96%E6%9C%AC-%E7%AB%9C%E7%BE%A9/dp/4254127928/ref=as_li_ss_il?ie=UTF8&qid=1478165293&sr=8-1&keywords=%E7%B5%8C%E6%B8%88%E3%83%BB%E3%83%95%E3%82%A1%E3%82%A4%E3%83%8A%E3%83%B3%E3%82%B9%E3%83%87%E3%83%BC%E3%82%BF%E3%81%AE%E8%A8%88%E9%87%8F%E6%99%82%E7%B3%BB%E5%88%97%E5%88%86%E6%9E%90&linkCode=li2&tag=aokikenichi-22&linkId=53c071200e6bc21d9723dd3a5f926476" target="_blank"><img border="0" src="//ws-fe.amazon-adsystem.com/widgets/q?_encoding=UTF8&ASIN=4254127928&Format=_SL160_&ID=AsinImage&MarketPlace=JP&ServiceVersion=20070822&WS=1&tag=aokikenichi-22" ></a><img src="https://ir-jp.amazon-adsystem.com/e/ir?t=aokikenichi-22&l=li2&o=9&a=4254127928" width="1" height="1" border="0" alt="" style="border:none !important; margin:0px !important;" />
の章末問題で「コンピュータを用いて」とあるものをRで解いています。

* [サポートサイト（データダウンロード）](http://www.geocities.jp/tatsuyoshi_okimoto/books/tsa.html)

# 6.4
```r
msci<-read.table("msci_day.txt", header=T)
msci.log<-log(msci[,2:8])
dim(msci.log)
```

```r
[1] 1391    7
```

### (1)
```r
set.seed(1)
wn<-rnorm(1391)
hist(wn)
```
![Rplot13.png](https://qiita-image-store.s3.amazonaws.com/0/116049/2a2d7444-a556-1a28-18ea-d1d5d653df65.png)

### (2)
```r
out<-data.frame(matrix(1:21,nrow=7,ncol=3))
for (i in 1:7) {
  tmp.p<-lm(msci.log[,i]~wn)
  tmp.p.beta<-tmp.p$coefficients[2]
  tmp.f.stat<-summary(tmp.p)$fstatistic
  tmp.p.p.value<-1-pf(tmp.f.stat["value"],tmp.f.stat["numdf"],tmp.f.stat["dendf"])
  tmp.p.adj.r.squared<-summary(tmp.p)$adj.r.squared
  out[i,]<-data.frame(matrix(c(tmp.p.beta, tmp.p.p.value, tmp.p.adj.r.squared), nrow=1))
}
colnames(out)<-c("推定値β^", "p値", "決定係数")
rownames(out)<-colnames(msci.log)
out
```

```r
   推定値β^       p値　　　　決定係数
ca  -0.005197388 0.5748192 -0.0004931680
fr  -0.003196312 0.6706261 -0.0005895938
ge  -0.003614680 0.6928374 -0.0006074941
it  -0.003411967 0.5995188 -0.0005212435
jp  -0.001184826 0.8467281 -0.0006930146
uk  -0.002621959 0.6630235 -0.0005831074
us  -0.002241276 0.5714044 -0.0004890948
```
調整済み決定係数なので、負の値になっているが実質ほぼ0。

### (3)
```r
rw<-cumsum(wn)
plot(rw, type="l")
```
![Rplot14.png](https://qiita-image-store.s3.amazonaws.com/0/116049/543f7519-5ec8-a838-bb0f-c55886fd443f.png)

### (4) 
```r
out<-data.frame(matrix(1:21,nrow=7,ncol=3))
for (i in 1:7) {
  tmp.p<-lm(msci.log[,i]~rw)
  tmp.p.beta<-tmp.p$coefficients[2]
  tmp.f.stat<-summary(tmp.p)$fstatistic
  tmp.p.p.value<-1-pf(tmp.f.stat["value"],tmp.f.stat["numdf"],tmp.f.stat["dendf"])
  tmp.p.adj.r.squared<-summary(tmp.p)$adj.r.squared
  out[i,]<-data.frame(matrix(c(tmp.p.beta, tmp.p.p.value, tmp.p.adj.r.squared), nrow=1))
}
colnames(out)<-c("推定値β^", "p値", "決定係数")
rownames(out)<-colnames(msci.log)
out
```

```r
   推定値β^       p値　　　　決定係数
ca -0.022671268   0        0.6988062
fr -0.017622486   0        0.6416288
ge -0.021094733   0        0.6201344
it -0.014705891   0        0.5976875
jp -0.013653738   0        0.5790067
uk -0.013868895   0        0.6199455
us -0.008966661   0        0.5982770
```
見せかけの回帰の現象が見られる。
テキストとホワイトノイズの値が異なるので値は一致しないが、p125の表6.1と同等にp値が0で決定係数が高めに出ている。


### (5)
```r
for (i in 1:1) {
  rw_1<-0
  y_1<-0
  rw_1[1]<-0
  y_1[1]<-0
  for (j in 2:1391) {
    rw_1[j]<-rw[j-1]
    y_1[j]<-msci.log[j-1,i]
  }
  tmp.p<-lm(msci.log[,i]~rw+rw_1+y_1)
  tmp.p.beta<-tmp.p$coefficients[2]
  tmp.f.stat<-summary(tmp.p)$fstatistic
  tmp.p.p.value<-1-pf(tmp.f.stat["value"],tmp.f.stat["numdf"],tmp.f.stat["dendf"])
  tmp.p.adj.r.squared<-summary(tmp.p)$adj.r.squared
  out[i,]<-data.frame(matrix(c(tmp.p.beta, tmp.p.p.value, tmp.p.adj.r.squared), nrow=1))
}
colnames(out)<-c("推定値β^", "p値", "決定係数")
rownames(out)<-colnames(msci.log)
out
```

```
   推定値β^       p値　　　　決定係数
ca -0.007613280   0        0.8812688
fr -0.017622486   0        0.6416288
ge -0.021094733   0        0.6201344
it -0.014705891   0        0.5976875
jp -0.013653738   0        0.5790067
uk -0.013868895   0        0.6199455
us -0.008966661   0        0.5982770
```
見せかけの回帰の現象が見られる。

## 6.5
```r
ppp<-read.table("ppp.txt", header=T)
```

### (1)
```r
lcpijp<-ts(log(ppp$cpijp),start=c(1974,1),frequency=12)
lcpius<-ts(log(ppp$cpius),start=c(1974,1),frequency=12)
lexjp<-ts(log(ppp$exjp),start=c(1974,1),frequency=12)
par(mfrow=c(3,2))
par(mar=c(2,4,1,1))
ts.plot(ts(ppp$cpijp,start=c(1974,1),frequency=12),ylab="cpijp")
ts.plot(lcpijp,ylab="log(cpijp)")
ts.plot(ts(ppp$cpius,start=c(1974,1),frequency=12),ylab="cpius")
ts.plot(lcpius,ylab="log(cpius)")
ts.plot(ts(ppp$exjp,start=c(1974,1),frequency=12),ylab="exjp")
ts.plot(lexjp,ylab="log(exjp)")
```
![Rplot15.png](https://qiita-image-store.s3.amazonaws.com/0/116049/066e2682-0387-71a4-0584-4d8f8aac69b7.png)

### (2)
```{r}
library(tseries)
adf.test(lcpijp)
adf.test(lcpijp, alternative = "explosive")
adf.test(lcpius)
adf.test(lcpius, alternative = "explosive")
adf.test(lexjp)
adf.test(lexjp, alternative = "explosive")
```

```
> adf.test(lcpijp)

	Augmented Dickey-Fuller Test

data:  lcpijp
Dickey-Fuller = -4.0654, Lag order = 7, p-value = 0.01
alternative hypothesis: stationary

Warning message:
In adf.test(lcpijp) : p-value smaller than printed p-value
> adf.test(lcpijp, alternative = "explosive")

	Augmented Dickey-Fuller Test

data:  lcpijp
Dickey-Fuller = -4.0654, Lag order = 7, p-value = 0.99
alternative hypothesis: explosive

Warning message:
In adf.test(lcpijp, alternative = "explosive") :
  p-value smaller than printed p-value
> adf.test(lcpius)

	Augmented Dickey-Fuller Test

data:  lcpius
Dickey-Fuller = -2.4815, Lag order = 7, p-value =
0.3739
alternative hypothesis: stationary

> adf.test(lcpius, alternative = "explosive")

	Augmented Dickey-Fuller Test

data:  lcpius
Dickey-Fuller = -2.4815, Lag order = 7, p-value =
0.6261
alternative hypothesis: explosive

> adf.test(lexjp)

	Augmented Dickey-Fuller Test

data:  lexjp
Dickey-Fuller = -1.6156, Lag order = 7, p-value =
0.7396
alternative hypothesis: stationary

> adf.test(lexjp, alternative = "explosive")

	Augmented Dickey-Fuller Test

data:  lexjp
Dickey-Fuller = -1.6156, Lag order = 7, p-value =
0.2604
alternative hypothesis: explosive
```


### (3)
```r
lrexjp<-lcpijp-lcpius-lexjp
par(mar=c(2,4,1,4))
plot(lrexjp, ylab="log(rexjp)")
```
![Rplot16.png](https://qiita-image-store.s3.amazonaws.com/0/116049/7effbfdc-3e57-78b1-58c7-97dce07c8746.png)

### (4)
PPP仮説は
$$
lcpijp \approx lexjp + lcpius
$$
であるから
$$
lcpijp - lcpius - lexjp = lrexjp \approx 0 
$$
よりlrexjpが0に収束することを示唆している。

### (5)
```r
adf.test(lrexjp)
adf.test(lrexjp, alternative = "explosive")
adf.test(diff(lrexjp))
```

```r
> adf.test(lrexjp)

	Augmented Dickey-Fuller Test

data:  lrexjp
Dickey-Fuller = -1.3335, Lag order = 7, p-value =
0.8587
alternative hypothesis: stationary

> adf.test(lrexjp, alternative = "explosive")

	Augmented Dickey-Fuller Test

data:  lrexjp
Dickey-Fuller = -1.3335, Lag order = 7, p-value =
0.1413
alternative hypothesis: explosive

> adf.test(diff(lrexjp))

	Augmented Dickey-Fuller Test

data:  diff(lrexjp)
Dickey-Fuller = -6.7109, Lag order = 7, p-value = 0.01
alternative hypothesis: stationary

Warning message:
In adf.test(diff(lrexjp)) : p-value smaller than printed p-value
```
より、単位根がある。このためlrexjpの値が収束しないので、PPP仮説を支持していない。

### (6)
```r
library(urca)
lrexjp.df<-data.frame(lcpijp, -lcpius, -lexjp)
lrexjp.vecm<-ca.jo(lrexjp.df, ecdet="none", type="eigen", K=6, spec="longrun", season=NULL)
summary(lrexjp.vecm)
```

```r
> summary(lrexjp.vecm)

###################### 
# Johansen-Procedure # 
###################### 

Test type: maximal eigenvalue statistic (lambda max) , with linear trend 

Eigenvalues (lambda):
[1] 0.158408638 0.032735262 0.002925689

Values of teststatistic and critical values of test:

          test 10pct  5pct  1pct
r <= 2 |  1.14  6.50  8.18 11.65
r <= 1 | 12.98 12.91 14.90 19.19
r = 0  | 67.26 18.90 21.07 25.75

Eigenvectors, normalised to first column:
(These are the cointegration relations)

              lcpijp.l6 X.lcpius.l6 X.lexjp.l6
lcpijp.l6    1.00000000   1.0000000  1.0000000
X.lcpius.l6  0.02892562   0.2519313  0.7927706
X.lexjp.l6  -0.07537271  -0.3823289  0.1300192

Weights W:
(This is the loading matrix)

              lcpijp.l6 X.lcpius.l6    X.lexjp.l6
lcpijp.d   -0.021872635 0.002756738 -0.0007592322
X.lcpius.d  0.014398742 0.008619883 -0.0038549536
X.lexjp.d   0.002801142 0.061199460  0.0184638162
```
r = 1
r+1=2個の共和分関係が存在する。よってPPP仮説を支持する。

### (7)
```r
lcpica<-ts(log(ppp$cpica),start=c(1974,1),frequency=12)
lcpiuk<-ts(log(ppp$cpiuk),start=c(1974,1),frequency=12)
lexca<-ts(log(ppp$exca),start=c(1974,1),frequency=12)
lexuk<-ts(log(ppp$exuk),start=c(1974,1),frequency=12)

lrexca.df<-data.frame(lcpica, -lcpius, -lexca)
lrexca.vecm<-ca.jo(lrexca.df, ecdet="none", type="eigen", K=6, spec="longrun", season=NULL)
summary(lrexca.vecm)
```

```r
###################### 
# Johansen-Procedure # 
###################### 

Test type: maximal eigenvalue statistic (lambda max) , with linear trend 

Eigenvalues (lambda):
[1] 0.104204155 0.016269511 0.002260424

Values of teststatistic and critical values of test:

          test 10pct  5pct  1pct
r <= 2 |  0.88  6.50  8.18 11.65
r <= 1 |  6.40 12.91 14.90 19.19
r = 0  | 42.92 18.90 21.07 25.75

Eigenvectors, normalised to first column:
(These are the cointegration relations)

             lcpica.l6 X.lcpius.l6 X.lexca.l6
lcpica.l6   1.00000000   1.0000000   1.000000
X.lcpius.l6 0.97756101   1.2966193   2.087184
X.lexca.l6  0.04893602   0.6192151  -1.629409

Weights W:
(This is the loading matrix)

              lcpica.l6  X.lcpius.l6    X.lexca.l6
lcpica.d   -0.013164472 -0.001479385  0.0003232371
X.lcpius.d  0.009339536 -0.007286482 -0.0011414028
X.lexca.d   0.032099791 -0.011930871  0.0031450132
```

```r
lrexuk.df<-data.frame(lcpiuk, -lcpius, -lexuk)
lrexuk.vecm<-ca.jo(lrexuk.df, ecdet="none", type="eigen", K=6, spec="longrun", season=NULL)
summary(lrexuk.vecm)
```

```r
###################### 
# Johansen-Procedure # 
###################### 

Test type: maximal eigenvalue statistic (lambda max) , with linear trend 

Eigenvalues (lambda):
[1] 0.128672334 0.030943227 0.007768275

Values of teststatistic and critical values of test:

          test 10pct  5pct  1pct
r <= 2 |  3.04  6.50  8.18 11.65
r <= 1 | 12.26 12.91 14.90 19.19
r = 0  | 53.72 18.90 21.07 25.75

Eigenvectors, normalised to first column:
(These are the cointegration relations)

             lcpiuk.l6 X.lcpius.l6 X.lexuk.l6
lcpiuk.l6    1.0000000   1.0000000   1.000000
X.lcpius.l6  0.5757486   1.3613908   1.945102
X.lexuk.l6  -2.0586854   0.9541808  -0.105148

Weights W:
(This is the loading matrix)

              lcpiuk.l6  X.lcpius.l6   X.lexuk.l6
lcpiuk.d   -0.005272950 -0.003607554  0.001152957
X.lcpius.d  0.002705188 -0.006229943 -0.003849241
X.lexuk.d   0.011352610 -0.017602665  0.026309049
```

r = 1
r+1=2個の共和分関係が存在する。よってPPP仮説を支持する。

次は [『経済・ファイナンスデータの計量時系列分析』章末問題をRで解く－第7章GARCHモデル－](http://qiita.com/aokikenichi/items/06a4de274e98a33af50a)