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

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

社会生活基本調査データの分析5 - R言語のlm関数で年齢を他の変数で回帰分析する。poly関数も使ってみた。

 

www.crosshyou.info

 の続きです。

今回は、R言語のlm関数を使って、年齢を他の変数で回帰分析してみようと思います。

まず、年齢はどういうデータだったか確認です。

f:id:cross_hyou:20190323150533j:plain

12歳から始まって5歳ずつ増えて77歳までです。男性と女性があるので2回ずつ出現しています。

どのようなデータがあるか、str関数で確認します。

f:id:cross_hyou:20190323150731j:plain

Sexは男性か女性かのファクタ、Ageも年齢のファクタです。3番目の変数のSample_sizeから16番目の変数のOtherまでが数値型の変数です。まずは、この数値型の変数と年齢の相関係数を見てみましょう。cor関数です。

f:id:cross_hyou:20190323151248j:plain

う~~ん。見難いですね。これを名前付きのベクトルにして、sort関数で並び替えましょう。colnames関数とsort関数を使います。

f:id:cross_hyou:20190323152309j:plain

Foreign_languagesが-0.8866812で一番逆相関で、Sample_sizeが0.7885006で一番の順相関です。

Foreign_languagesで年齢を回帰したモデルと、Sample_sizeで年齢を回帰したモデル、2つ試してみましょう。

まずは、Foreign_languagesで回帰したモデル、model_Fです。

f:id:cross_hyou:20190323153010j:plain

一番下のF統計量の検定がp-value: 3.376e-10 となっていますので、モデルは有意です。

Foreign_languagesの係数のPr(>|t|)が3.38e-10ですから、Foreign_languagesはモデルに有効な役割をはたしていいます。モデルのあてはまりのよさは、R-squaredが0.78862です。

次は、Sample_sizeを説明変数にしたmodel_Sです。

f:id:cross_hyou:20190323153524j:plain

一番下の行、F統計量のp値は6.25e-07と0.5よりも小さいので、モデルは有意です。

Sample_sizeの係数のp値は6.25e-07なのでSample_sizeはモデルで有効な変数です。モデルの当てはまりは、Multipe R-squaredが0.6217です。

R-squaredはmodel_Fのほうがいいですね。散布図に回帰式を当てはめてみましょう。

まずは、model_Fからです。plot関数とabline関数ですね。

f:id:cross_hyou:20190323154056j:plain

f:id:cross_hyou:20190323154108j:plain

次は、model_Sです。

f:id:cross_hyou:20190323154310j:plain

f:id:cross_hyou:20190323154323j:plain

目で見るかぎり、どちらが当てはまっているか判断できないですね。

2乗項を入れてみましょうか?

まずは、model_Fに2乗項を追加した、model_F2です。lm関数の中で、poly関数を使います。

f:id:cross_hyou:20190323162501j:plain



一番下の行のF統計量のp値は1.045e-14と0.05よりも小さいのでモデルは有意です。

係数もForeign_languagesは3.10e-10, その2乗項は4.79e-07とどちらも有意、Adjusted R-squaredは0.9178とmodel_Sよりもあてはまりがよくなりました。

model_Sに2乗項を追加したモデル、model_S2はどうでしょうか?

f:id:cross_hyou:20190323162628j:plain



こちらもF統計量のp値は有意を示し、Sample_size, Sample_sizeの2乗の係数ともに有意を示しています。Adjusted R-aquaredは0.7145とmodel_Sよりも改善しています。

それぞれの回帰線と散布図を描いてみます。各回帰モデルの中にfitted.valuesという値が格納されていますので、それを使います。

f:id:cross_hyou:20190323162816j:plain

f:id:cross_hyou:20190323162825j:plain


はじめの2行、xrange =, yrange =でX軸とY軸の範囲を指定しています。par(new = TRUE)で作成したグラフに上書きするようにしています。赤い点が回帰モデルの計算結果です。model_Fの直線よりは当てはまっていますね。

model_S2も同じようにやってみます。

f:id:cross_hyou:20190323162954j:plain

 

f:id:cross_hyou:20190323163004j:plain

こちらもmodel_Sよりも当てはまりはいいですね。

今回は以上です。

 

今回のコードは以下のとおりです。


# 年齢データの確認
dfnew$Age_n

# 変数の確認
str(dfnew)

# 相関係数の確認
cor(dfnew$Age_n, dfnew[ , c(-1, -2, -17)])

# 相関係数の名前付きベクトル
name_soukan <- cor(dfnew$Age_n, dfnew[ , c(-1, -2, -17)])
names(name_soukan) <- colnames(name_soukan)
sort(name_soukan)

# Foreign_languagesで年齢を回帰したモデル
model_F <- lm(Age_n ~ Foreign_languages, data = dfnew)
summary(model_F)

# Sample_sizeで年齢を回帰したモデル
model_S <- lm(Age_n ~ Sample_size, data = dfnew)
summary(model_S)

# model_Fの回帰式と散布図
plot(dfnew$Foreign_languages, dfnew$Age_n)
abline(model_F, col = "red")

# model_Sの回帰式と散布図
plot(dfnew$Sample_size, dfnew$Age_n)
abline(model_S, col = "blue")

# Model_Fに2乗項を追加
model_F2 <- lm(Age_n ~ poly(Foreign_languages, 2, raw = TRUE), data = dfnew)
summary(model_F2)

# model_Sに2乗項を追加
model_S2 <- lm(Age_n ~ poly(Sample_size, 2, raw = TRUE), data = dfnew)
summary(model_S2)

# model_F2の回帰線と散布図
yrange = range(dfnew$Age_n, model_F2$fitted.values)
xrange = range(dfnew$Foreign_languages)
plot(dfnew$Foreign_languages, dfnew$Age_n,
xlim = xrange, ylim = yrange, xlab = "", ylab = "", main = "")
par(new = TRUE)
plot(dfnew$Foreign_languages, model_F2$fitted.values,
xlim = xrange, ylim = yrange, xlab = "Foreign_languages", ylab = "Age_n", main = "model_F2",
col = "red", pch = 19)

# model_S2の回帰プロットと散布図
yrange = range(dfnew$Age_n, model_S2$fitted.values)
xrange = range(dfnew$Sample_size)
plot(dfnew$Sample_size, dfnew$Age_n, xlim = xrange, ylim = yrange,
xlab = "", ylab = "", main = "")
par(new = TRUE)
plot(dfnew$Sample_size, model_S2$fitted.values, xlim = xrange, ylim = yrange,
xlab = "Sample_size", ylab = "Age_n", main = "model_S2",
col = "blue", pch = 19)