Content

金融政策や財政政策の効果が顕在化するまでには『遅れ』がつきもの。では効果が現れるまでにはどの位の遅れが?そこでお世話になるのが相互相関関数。日本のマネタリーベース(source:日本銀行)と日経平均株価(source:日本経済新聞)をサンプルデータ(ともに月次)としてRによる相互相関関数を確認してみましょう。なお有意水準は5%として進めます。
# サンプルデータ
head(sampleData)
cat("-----------------------------------------\n")
tail(sampleData)
        Date MonetaryBase NIKKEI225
1 2014-04-01     222.0795  14304.11
2 2014-05-01     224.3719  14632.38
3 2014-06-01     233.2465  15162.10
4 2014-07-01     243.1068  15620.77
5 2014-08-01     242.3138  15424.59
6 2014-09-01     245.8169  16173.52
-----------------------------------------
         Date MonetaryBase NIKKEI225
55 2018-10-01     501.6198  21920.46
56 2018-11-01     501.3302  22351.06
57 2018-12-01     497.0034  20014.77
58 2019-01-01     499.7797  20773.49
59 2019-02-01     493.0980  21385.16
60 2019-03-01     494.2027  21205.81
# 単位根検定 H0:非定常過程
# レベルデータ
apply(sampleData[, -1], 2, function(x) adf.test(x))
cat("-----------------------------------------\n")
# 一階差分
apply(sampleData[, -1], 2, function(x) adf.test(diff(x)))
$MonetaryBase

    Augmented Dickey-Fuller Test

data:  x
Dickey-Fuller = 1.0683, Lag order = 3, p-value = 0.99
alternative hypothesis: stationary


$NIKKEI225

    Augmented Dickey-Fuller Test

data:  x
Dickey-Fuller = -1.8423, Lag order = 3, p-value = 0.6385
alternative hypothesis: stationary


-----------------------------------------
$MonetaryBase

    Augmented Dickey-Fuller Test

data:  diff(x)
Dickey-Fuller = -3.9858, Lag order = 3, p-value = 0.0164
alternative hypothesis: stationary


$NIKKEI225

    Augmented Dickey-Fuller Test

data:  diff(x)
Dickey-Fuller = -4.2141, Lag order = 3, p-value = 0.01
alternative hypothesis: stationary
# 共和分検定 H0:共和分関係無し
summary(ca.po(z = sampleData[, -1], type = "Pu"))

######################################## 
# Phillips and Ouliaris Unit Root Test # 
######################################## 

Test of type Pu 
detrending of series none 


Call:
lm(formula = z[, 1] ~ z[, -1] - 1)

Residuals:
    Min      1Q  Median      3Q     Max 
-118.14  -72.51   26.74   48.72   85.78 

Coefficients:
         Estimate Std. Error t value Pr(>|t|)    
z[, -1] 0.0205460  0.0004195   48.98   <2e-16 ***
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Residual standard error: 62.9 on 59 degrees of freedom
Multiple R-squared:  0.976, Adjusted R-squared:  0.9756 
F-statistic:  2399 on 1 and 59 DF,  p-value: < 2.2e-16


Value of test-statistic is: 0.4758 

Critical values of Pu are:
                  10pct    5pct    1pct
critical values 20.3933 25.9711 38.3413
# 相互相関関数を算出する関数です。
calculate_ccf <- function(x0, y0, lag, significantLevel = 0.05) {
    if (lag < 0) {
        x <- head(x0, lag)
        y <- tail(y0, lag)
    } else if (0 < lag) {
        x <- tail(x0, -lag)
        y <- head(y0, -lag)
    } else {
        x <- x0
        y <- y0
    }
    mux <- mean(x0)
    muy <- mean(y0)
    dx <- mean((x0 - mux)^2)
    dy <- mean((y0 - muy)^2)
    n <- length(x0)
    cxy <- sum((x - mux) * (y - muy))/n
    ccf <- cxy/sqrt(dx * dy)
    upperCI <- qnorm((1 + (1 - significantLevel))/2)/sqrt(length(x0))
    lowerCI <- -qnorm((1 + (1 - significantLevel))/2)/sqrt(length(x0))
    return(data.frame(lag = lag, ccf = ccf, upperCI = upperCI, lowerCI = lowerCI))
}
# 両系列とも一階差分を分析対象とします
sampleData_1stdiff <- data.frame(apply(sampleData[, c(2, 3)], 2, diff))
colnames(sampleData_1stdiff) <- paste0(colnames(sampleData_1stdiff), "_1stDifference")
# 正規性検定 H0:サンプルの分布は正規分布に従う
apply(sampleData_1stdiff, 2, function(x) ks.test(x, y = "pnorm", mean = mean(x), sd = sd(x), exact = T))
$MonetaryBase_1stDifference

    One-sample Kolmogorov-Smirnov test

data:  x
D = 0.0837, p-value = 0.7715
alternative hypothesis: two-sided


$NIKKEI225_1stDifference

    One-sample Kolmogorov-Smirnov test

data:  x
D = 0.1412, p-value = 0.1727
alternative hypothesis: two-sided
# qqplot
qqnorm(sampleData_1stdiff$MonetaryBase_1stDifference)
qqline(sampleData_1stdiff$MonetaryBase_1stDifference, col = 2)

qqnorm(sampleData_1stdiff$NIKKEI225_1stDifference)
qqline(sampleData_1stdiff$NIKKEI225_1stDifference, col = 2)

# マネタリーベースと日経平均株価の相互相関関数(ともに一階差分)
Reduce(function(x, y) rbind(x, y), lapply(-12:12, function(x) calculate_ccf(x0 = sampleData_1stdiff[, 1], y0 = sampleData_1stdiff[, 2], lag = x)))
   lag          ccf   upperCI    lowerCI
1  -12  0.154342345 0.2551656 -0.2551656
2  -11 -0.066745636 0.2551656 -0.2551656
3  -10  0.076212988 0.2551656 -0.2551656
4   -9 -0.064026090 0.2551656 -0.2551656
5   -8 -0.197936426 0.2551656 -0.2551656
6   -7  0.080267816 0.2551656 -0.2551656
7   -6  0.142577763 0.2551656 -0.2551656
8   -5 -0.074798052 0.2551656 -0.2551656
9   -4  0.093750969 0.2551656 -0.2551656
10  -3 -0.001396644 0.2551656 -0.2551656
11  -2 -0.181659203 0.2551656 -0.2551656
12  -1  0.215874200 0.2551656 -0.2551656
13   0  0.110775373 0.2551656 -0.2551656
14   1 -0.084030777 0.2551656 -0.2551656
15   2  0.088171799 0.2551656 -0.2551656
16   3 -0.088355946 0.2551656 -0.2551656
17   4 -0.009945433 0.2551656 -0.2551656
18   5  0.086902683 0.2551656 -0.2551656
19   6  0.163368327 0.2551656 -0.2551656
20   7 -0.134260473 0.2551656 -0.2551656
21   8  0.017306254 0.2551656 -0.2551656
22   9  0.047802883 0.2551656 -0.2551656
23  10 -0.218960722 0.2551656 -0.2551656
24  11  0.077714867 0.2551656 -0.2551656
25  12  0.054049636 0.2551656 -0.2551656
# 何も関数を自作しなくてもRでは相互相関関数'ccf'が用意されています。
attach(sampleData_1stdiff)
print(ccf(x = MonetaryBase_1stDifference, y = NIKKEI225_1stDifference, lag.max = 12))


Autocorrelations of series 'X', by lag

   -12    -11    -10     -9     -8     -7     -6     -5     -4     -3     -2     -1      0      1      2      3      4      5      6      7      8      9     10     11     12 
 0.154 -0.067  0.076 -0.064 -0.198  0.080  0.143 -0.075  0.094 -0.001 -0.182  0.216  0.111 -0.084  0.088 -0.088 -0.010  0.087  0.163 -0.134  0.017  0.048 -0.219  0.078  0.054 
今回のサンプルデータでは有意な関係が見られませんでした。金融政策の効果を「せっつく」輩には「ラグがあるのですよ」と言い訳(?)の材料としても使えます。