
の続きです。に続いて、今回は人口密度と刑法犯認知件数の関係をみてみます。
人口密度のデータフレームを作成するところからはじめます。

このdf_mitsudoに前回作成したdf_popを合体させます。

summary()関数でデータフレームのサマリーをみてみましょう。

year, pref, cityをファクター型にします。

調査年度は1985, 1990, 1995, 2000, 2005の5つの年度です。いわき市やさいたま市などは5つの年度すべてでデータあるということですね。でも、さいたま市って1985年度はまだ大宮市や浦和市など合併前だったような気がします。遡及してデータを作ったんでしょうか。
それでは、人口密度とcrimeの散布図を描いてみます。


人口とcrimeの散布図のようなL字型の分布では無いですね。微妙に右肩上がりの散布図に見えます。
では、crimeをmitsudoだけで回帰分析してみます。

summary()関数で結果をみてみます。

p-valueは2.406e-10と0.05よりもうんと0に近いですので、mitsudoはcrimeと関連があるといえます。係数は0.0008405ですので、0に近いですが、プラスです。つまり、人口密度が高い市ほど、刑法犯認知件数は多いということですね。
ただ、R2(決定係数)は0.08591とかなり小さい値ですから、人口密度で刑法犯認知件数を説明することはほとんどできていないです。
実際のcrimeとモデルが予測した値の散布図を描いてみます。


右にある外れ値が気になりますね。
前回のpop_mod2で使った説明変数、year, pref, pop, pop^2, l_pop, l_pop^2を加えて回帰分析モデルを作ります。

summary()関数で結果をみてみます。

中略

mitsudoの係数は、4.470e-04(0.0004470)でした。人口や調査年度、都道府県をコントロールしてもmitsudoの係数はプラスでp値も0.008788と0.05よりも小さいので、人口密度が高いほど、刑法犯認知件数は高いということは言えます。
また、R2は0.8295とこのモデルで82.95%はcrimeの値を説明できます。
mitsudoを含まないモデル、pop_mod2とR2, Adjusted R2の比較をしてみます。

R2, Adj. R2ともにmitsudoを入れたモデルのほうがいいですね。
最後に実際のcrimeとmitsudo_mod2のモデルの予測値を散布図にしてみます。


右にあったcrimeの外れ値が解消されていることがわかります。
今回は以上です。
はじめから読むには、
です。
今回のコードは以下になります。
#
# mitsudoのデータフレームを作成する
df_mitsudo <- df_raw |>
filter(!is.na(mitsudo)) |>
select(year, code, mitsudo)
df_mitsudo
#
# df_mitsudoにdf_popを合体させる
df_mitsudo <- df_mitsudo |>
inner_join(df_pop, by = join_by(year, code))
df_mitsudo
#
# df_mitsudoのサマリー
summary(df_mitsudo)
#
# year, pref, cityをファクター型にする
df_mitsudo <- df_mitsudo |>
mutate(
across(c(year, pref, city), as.factor)
)
summary(df_mitsudo)
#
# crimeとmitsudoの散布図
df_mitsudo |>
ggplot(aes(x = mitsudo, y = crime)) +
geom_point(aes(color = year)) +
theme_minimal()
#
# crimeをmitsudoで回帰分析
mitsudo_mod <- lm(crime ~ mitsudo, data = df_mitsudo)
#
# 結果
summary(mitsudo_mod)
#
# 実際のcrimeとモデルの予測値の散布図
df_mitsudo |>
mutate(estimate = predict(mitsudo_mod)) |>
ggplot(aes(x = crime, y = estimate)) +
geom_point(aes(color = year)) +
geom_abline() +
theme_minimal()
#
#
# year, pref, pop, pop^2, l_pop, l_pop^2も加える
mitsudo_mod2 <- lm(crime ~ mitsudo + pop + I(pop^2) + l_pop + I(l_pop^2) +
year + pref, data = df_mitsudo)
#
# 結果
summary(mitsudo_mod2)
#
# R2の比較
summary(mitsudo_mod2)$r.squared
summary(pop_mod2)$r.squared
#
# Adj. R2の比較
summary(mitsudo_mod2)$adj.r.squared
summary(pop_mod2)$adj.r.squared
#
# 実際の値とモデルの予測値の散布図
df_mitsudo |>
mutate(estimate = predict(mitsudo_mod2)) |>
ggplot(aes(x = crime, y = estimate)) +
geom_point(aes(color = year)) +
theme_minimal() +
geom_abline(color = "red")
#
(冒頭の画像は、Bing Image Creator で生成しました。プロンプトは、Natural scene landscape of wild land, close up of purple Akebia flower trees, blue sky, Photo です。)


























































