Rで何かをしたり、読書をするブログ

政府統計の総合窓口のデータや、OECDやUCIやのデータを使って、Rの練習をしています。ときどき、読書記録も載せています。

景気ウォッチャー調査の分野・業種DIのデータの分析4 - R で景気ウォッチャー調査データから TOPIX を回帰分析モデルで予測する

Bing Image Creator で生成: Close up photo of Euphorbia pulcherrima, background is wild green grass fields, photo

 

www.crosshyou.info

の続きです。今回は景気ウォッチャー調査のデータから TOPIX を予測するモデルを作ろうと思います。

まずは分析のために、total: 景気ウォッチャー調査総合値の current, future, level と TOPIX の ts オブジェクトを作ろうと思います。

df_ts という名前でデータフレームを、

time_series という名前で ts オブジェクトを作成しました。

この time_series の有り様を確認してみます。

時系列データを回帰分析するためのパッケージである dynlm を読み込みます。

一番はじめは、TOPIX の水準を、1か月前の current, future, level で説明するモデルを作ってみましょう。

current, future, level 全ての係数が有意な値となっています。current の係数がマイナスなので、current: 現状の方向性が低いと、TOPIX の値は大きくなる、という関係です。

R-squared が 0.2573 なので、25% しか TOPIX を説明していません。

モデルの予測値と実際の TOPIX の値をグラフにしてみます。

はじめにモデルの予測値と実際の TOPIX の値のデータフレームを作っておきます。

1か月前の景気ウォッチャー調査データを使ったモデルなので、一番最初の月の予想値はありません。

ggplot でグラフを描きます。

黒が実際の TOPIX で、赤がモデルの予測値です。同じような値動きですが、2020年以降の実際の TOPIX の上昇にモデルがついていけてないですね。

第2のモデルとして、トレンド項を追加したモデルを作ってみましょう。

トレンドは2乗項も加えました。R-squared が 0.7975 と改善しました。

グラフにしてみます。

緑のラインが2番目もモデルです。赤いラインよりも実際の TOPIX に近づいていることがわかります。

さらに、前月の TOPIX の値を加えたモデルを作ります。

L(current) や L(level) などは有意な係数ではなくなっています。

不要な変数を削除していって、モデルをより簡素なものにしていきます。

まず、L(level) を削除しました。次は、trend(time_series) を削除してみます。

L(future) は有意なままですね。L(current) を削除します。

L(future) は係数は 1.87 で、p値は 0.000442 と 1% 以下の有意水準です。

R-squared は 0.983 と このモデルで、TOPIX の値動きの 98.3% を説明しています。

景気ウォッチャー調査の先行きの方向性が1ポイント上がると、 topix は 1.87 上昇するということですね。

グラフにしてみます。

3番目のモデルの予測値は、ゴールドのラインです。黒い実際の TOPIX とよく似た値であることがわかります。

今回は以上です。

次回は

www.crosshyou.info

です。

 

初めから読むには、

www.crosshyou.info

です。

今回のコードは以下になります。

#
# total の current, future, level と topix のts オブジェクトを作る
df_ts <- df |> 
  select(date, year, month, type, total) |> # 必要な変数だけ
  pivot_wider( # pivot_woder()で変形
    id_cols = c("date", "year", "month"),
    names_from = type,
    values_from = total
  ) |> 
  inner_join(tpx) |> # topixを結合
  arrange(date) # 日付順に並び替え
#
time_series <- ts(df_ts,
                  start = c(2000, 1), frequency = 12)# ts オブジェクトにする
#
# time_series の確認
head(time_series)
tail(time_series)
str(time_series)
#
# dynlm パッケージを読み込む
library(dynlm)
#
# topix を1期前のcurrent, future, level で説明するモデル
model1 <- dynlm(topix ~ L(current) + L(future) + L(level), 
                data = time_series)
summary(model1)
#
# 実際のTopixとモデルのTopix のデータフレームを作る
#
df_topix_model <- 
tibble(
  date = df_ts$date,
  model1 = c(NA, model1$fitted.values),
  topix = df_ts$topix

df_topix_model
#
# 実際のTopixとモデルのTopixのグラフ
df_topix_model |> 
  ggplot(aes(x = date)) +
  geom_line(aes(y = topix)) +
  geom_line(aes(y = model1), color = "red") +
  labs(title = "Black-Topix, Red-Model1")
#
# トレンドを加えたモデル
model2 <- dynlm(topix ~ L(current) + L(future) + L(level) +
                  trend(time_series) + I(trend(time_series)^2),
                data = time_series)
summary(model2)
#
# model2の予測値をdf_topix_modelに加える
df_topix_model <- df_topix_model |> 
  mutate(model2 = c(NA, model2$fitted.values))
df_topix_model
#
# グラフ
df_topix_model |> 
  ggplot(aes(x = date)) +
  geom_line(aes(y = topix)) +
  geom_line(aes(y = model1), color = "red") +
  geom_line(aes(y = model2), color = "green") +
  labs(title = c("Black-Topix, Red-Model1, Green-Model2"))
#
# 前月のtopixも加えたモデル
model3 <- dynlm(topix ~ L(current) + L(future) + L(level) +
                  trend(time_series) + I(trend(time_series)^2) +
                  L(topix), data = time_series)
summary(model3)
#
# model3 の簡素化作業1 L(level) を削除
model3 <- dynlm(topix ~ L(current) + L(future) +
                  trend(time_series) + I(trend(time_series)^2) +
                  L(topix), data = time_series)
summary(model3)
#
# model3 の簡素化作業2 trend(time_series) を削除
model3 <- dynlm(topix ~ L(current) + L(future) +
                  I(trend(time_series)^2) +
                  L(topix), data = time_series)
summary(model3)
#
# model3 の簡素化作業3 L(current) を削除
model3 <- dynlm(topix ~ L(future) +
                  I(trend(time_series)^2) +
                  L(topix), data = time_series)
summary(model3)
#
# model3の予測値をdf_topix_modelに加える
df_topix_model <- df_topix_model |> 
  mutate(model3 = c(NA, model3$fitted.values))
df_topix_model
#
# グラフ
df_topix_model |> 
  ggplot(aes(x = date)) +
  geom_line(aes(y = topix)) +
  geom_line(aes(y = model1), color = "red") +
  geom_line(aes(y = model2), color = "green") +
  geom_line(aes(y = model3), color = "gold", linewidth = 1, alpha = 0.5) +
  labs(title = c("Black-Topix, Red-Model1, Green-Model2, Gold-Model3")) +
  theme_bw()
#