の続きです。
今回はメインタイトルどおり、人口の推移と株価の関係を分析してみようと思います。
まずは、全国の総人口と男性比率と日本人比率、この3つの説明変数と株価の関係を分析してみたいと思います。
まず、分析用のデータフレーム、ad(analysis data.frame)を作成します。
subset関数でまずは全国だけのデータにしました。男性比率(M/T), 日本人比率(J/T)を作成しましょう。
必要な変数は、Year1, T, MT, JTとKabukaです。subset関数で必要な変数だけにしてしまいます。
subset関数で必要な変数だけにして、変数の順番も変更しました。
まずは、pairs関数でそれぞれの変数の散布図を描きます。
グラフマトリックスの一番上の行が株価がY軸で各変数がX軸の散布図です。
cor関数で相関係数マトリックスも作成します。
年と男性比率が一番相関係数の絶対値が大きいですね。男性比率は年々低下しています。
それでは、lm関数で被説明変数を株価、残りを説明変数にして回帰分析をしてみます。
まずは、全ての変数と変数の二乗項、交差項も含んだフルモデルから分析します。
step関数を使って、Kabukaに影響のない変数を削除します。
summary関数で結果を表示します。
あれ、Year1:MTやJTは有意ではないですね。update関数でまず、Year1:JTを削除します。
これで、全ての変数が有意なモデルのなりました。残差をプロットしてみます。
plot関数ですね。
最後に実際の株価とモデルから予測された株価をグラフにしてみましょう。
plot関数で実際の株価のグラフを描いて、points関数でそのグラフにモデルから予想された株価を重ねます。
最後に今回の分析用データ(ad)を消去して終わります。
今回は以上です。
次回は
です。
今回の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
