(Bing Image Creator で生成: プロンプト: Close up of yellow Pieris japonica flowers, background is great long river and blue sky, photo)
の続きです。
今回は前回の線形回帰分析の説明変数に、enegy: １人当たり最終エネルギー消費を加えてみます。
早速やってみましょう。
energy の係数は 1.309 です。popratio がかわらないまま、１人当たり最終エネルギー消費が 1 ギガ・ジュール増えると、１人当たり県民総所得が 1309 円増える、ということです。
１ギガ・ジュールってどのくらいなのでしょうね。Copilotに聞いてみたら、
2億3900万カロリー！！だそうです。すごいですね。energy の平均値は、112ほどでしたので、平均よりも1%弱増えると1309円増えるという感覚です。
model3のサマリーを確認しましょう。
popratio の係数が 53.5791 と energy を入れないときよりも大きな係数になりました。
energy の p値は 0.077843 なので 5%水準では有意ではないですが、10%水準では有意ですね。
plot() 関数でグラフをみます。
左側のグラフをみるかぎり、Heteroskedasticity(残差の不均一分散)ではないようです。
Breush-Pagan Test をして確認します。
p-value は 0.6579 なので、Heteroskedasticity(残差の不均一分散)ではないです。
残差の2乗を回帰分析して確認する方法でもやってみます。
p-value は 0.6793 でした。
実際の income の値と model3 の推定値を散布図にしてみます。
沖縄県は、モデルの推計値よりも実際の income が小さく、愛知県はその反対にモデルの推計値よりも実際の income が大きいことがわかります。
最後に stargazer() 関数で model1, model2, model3 を比較してみます。
Adjusted R2 を比べると、model3 が 0.723 と一番大きな値です。
今回は以上です。
次回は
です。
初めから読むには、
です。
今回のコードは以下になります。
#
# model2 に energy を追加
model3 <- lm(income ~ popratio + tokyo + energy,
data = df_2020)
model3
#
# model3 のサマリー
summary(model3)
#
# model3 のプロット
par(mfrow = c(2, 2))
plot(model3)
par(mfrow = c(1, 1))
#
# Breush-Pagan Test
lmtest::bptest(model3)
#
# model3 の残差の2乗を popratio, tokyo, energy で回帰分析
lm(I(model3$residuals^2) ~ popratio + tokyo + energy,
data = df_2020) |>
summary()
#
# 実際の income と model3 の予測の income
tibble(actual_income = df_2020$income,
estimated_income = model3$fitted.values,
pref = df_2020$pref) |>
ggplot(aes(x = actual_income, y = estimated_income)) +
geom_point(color = "red") +
geom_text(aes(label = pref), hjust = 0.5, vjust = -0.5, alpha = 0.3) +
geom_abline(intercept = 0, slope = 1) +
theme_bw()
#
# model1, model2, model3 の比較
stargazer(model1, model2, model3, type = "text")
#
