6.4

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

[1] 1391    7

(1)

set.seed(1)
wn<-rnorm(1391)
hist(wn)

(2)

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

   推定値β^       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)

rw<-cumsum(wn)
plot(rw, type="l")

(4)

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

   推定値β^       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)

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

ppp<-read.table("ppp.txt", header=T)

(1)

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)")

(2)

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)

lrexjp<-lcpijp-lcpius-lexjp
par(mar=c(2,4,1,4))
plot(lrexjp, ylab="log(rexjp)")

(4)

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

(5)

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

> 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)

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)

> 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)

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)

###################### 
# 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

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)

###################### 
# 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モデル－