www.crosshyou.info

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

人口の推移と株価の関係の分析3- 株価と西暦、総人口、男性比率、日本人比率をR言語のlm関数で重回帰分析する。

 

www.crosshyou.info

 の続きです。

今回はメインタイトルどおり、人口の推移と株価の関係を分析してみようと思います。

まずは、全国の総人口と男性比率と日本人比率、この3つの説明変数と株価の関係を分析してみたいと思います。

まず、分析用のデータフレーム、ad(analysis data.frame)を作成します。

f:id:cross_hyou:20190509193835j:plain

subset関数でまずは全国だけのデータにしました。男性比率(M/T), 日本人比率(J/T)を作成しましょう。

f:id:cross_hyou:20190509194402j:plain

必要な変数は、Year1, T, MT, JTとKabukaです。subset関数で必要な変数だけにしてしまいます。

f:id:cross_hyou:20190509194802j:plain

subset関数で必要な変数だけにして、変数の順番も変更しました。

まずは、pairs関数でそれぞれの変数の散布図を描きます。

f:id:cross_hyou:20190509195143j:plain

f:id:cross_hyou:20190509195155j:plain

グラフマトリックスの一番上の行が株価がY軸で各変数がX軸の散布図です。
cor関数で相関係数マトリックスも作成します。

f:id:cross_hyou:20190509195440j:plain

年と男性比率が一番相関係数の絶対値が大きいですね。男性比率は年々低下しています。

それでは、lm関数で被説明変数を株価、残りを説明変数にして回帰分析をしてみます。

まずは、全ての変数と変数の二乗項、交差項も含んだフルモデルから分析します。

f:id:cross_hyou:20190509200026j:plain

step関数を使って、Kabukaに影響のない変数を削除します。

f:id:cross_hyou:20190509200655j:plain

f:id:cross_hyou:20190509200708j:plain

summary関数で結果を表示します。

f:id:cross_hyou:20190509200828j:plain

あれ、Year1:MTやJTは有意ではないですね。update関数でまず、Year1:JTを削除します。

f:id:cross_hyou:20190509201227j:plain

これで、全ての変数が有意なモデルのなりました。残差をプロットしてみます。

plot関数ですね。

f:id:cross_hyou:20190509201438j:plain

f:id:cross_hyou:20190509201453j:plain

最後に実際の株価とモデルから予測された株価をグラフにしてみましょう。

plot関数で実際の株価のグラフを描いて、points関数でそのグラフにモデルから予想された株価を重ねます。

f:id:cross_hyou:20190509202609j:plain

f:id:cross_hyou:20190509202621j:plain

最後に今回の分析用データ(ad)を消去して終わります。

f:id:cross_hyou:20190509202801j:plain

今回は以上です。

次回は

 

www.crosshyou.info

 

です。

今回のR言語のコードです。

# 分析用データ(ad)の作成
ad <- wd # wd(作業用の基データ)をadにコピー
ad <- subset(ad, subset = (Pref2 == "全国")) # 全国だけに絞り込む
head(ad) # 始めの数行の表示

# 男性比率と外国人比率の作成
ad$MT <- ad$M / ad$T # M(男性) / T(総人口)
ad$JT <- ad$J / ad$T # J(日本人) / T(総人口)
summary(ad$MT) # 男性比率(MT)のサマリー
summary(ad$JT) # 日本人比率(JT)のサマリー

# 必要な変数だけにする
ad <- subset(ad, select = c(Kabuka, Year1, T, MT, JT)) # 必要な変数だけ
summary(ad) # サマリー表示

# 変数どうしの散布図
pairs(ad, panel = panel.smooth)

# 相関係数マトリックス
cor(ad)

# フルモデルの分析
full_model <- lm(Kabuka ~ Year1 * T * MT * JT +
I(Year1^2) + I(T^2) + I(MT^2) + I(JT^2), data = ad) # モデルを作成
summary(full_model) # モデルのサマリー

# 不要な変数を削除
reduced_model <- step(full_model, direction = "backward")

# サマリー関数
summary(reduced_model)

# Year1:JTの削除
reduced_model2 <- update(reduced_model, ~ . -Year1:JT)
summary(reduced_model2)

# 残差グラフのプロット
plot(reduced_model2, which = 1)

# 実際の株価とモデルによる株価
plot(ad$Year1, ad$Kabuka, pch = 21, bg = "black", type = "b",
xlab = "西暦", ylab = "株価", main = "黒:実績  赤:モデル値",
ylim = c(0, 3000))
points(reduced_model2$model$Year1, reduced_model2$fitted.values,
pch = 21, bg = "red", type = "b")

# 分析用データ(ad)の消去
rm(ad)
ad