My Notes

統計学とかR(R言語)とかPython3の覚え書きとか走り書きとか。 座右の銘にしたい: All work and no play makes Jack a dull boy.

R(R言語)で、相関係数を求め単回帰分析、それを検討するために散布図、偏相関係数、重回帰分析(疑似相関を考える)

Rコード

#
# R(R言語)で、相関係数を求め単回帰分析、それを検討するために散布図、偏相関係数、重回帰分析(疑似相関を考える)。
#




#
# 使用するデータと解説は、『実践形式で学ぶ SPSSとAmosによる心理・調査データ解析』
# Exercise 2 p.10~17
#




#
# 書籍通りに従うと、
# 相関係数、単回帰分析、散布図、偏相関係数、疑似相関、重回帰分析 の順
# (ただし、書籍にある、分散分析と標準偏回帰係数は割愛)
#



#
# 研究テーマと分析の背景
#
# "生徒のなかで、足が速い子は記憶力も良いのではないか"
# "ランニングをすれば、体力もつき、足にかかる負担が脳にも適度な刺激となり、
# 活性化し、記憶力も良くなるのではないか"
# そこで、25名の生徒に記憶力テストを実施した。
# また、体力測定結果から50メートル走のタイム(秒)を調べた。
#




# 使用するデータ
ID_vec <- c(1:25)

年齢_vec <- c(10, 12, 11, 9, 8,
            11, 12, 9, 8, 8,
            11, 9, 10, 10, 8,
            9, 9, 11, 10, 12,
            12, 10, 8, 12, 11)

記憶成績_vec <- c(10, 11, 11, 6, 8,
                14, 14, 11, 5, 6,
                13, 5, 11, 9, 9,
                8, 10, 11, 8, 13,
                11, 10, 7, 15, 13)

タイム_vec <- c(8, 8, 9, 11, 12,
                7, 8, 11, 13, 12,
                11, 11, 11, 12, 13,
                12, 13, 8, 9, 7,
                8, 10, 14, 8, 9)

df <- data.frame(年齢 = 年齢_vec,
                記憶成績 = 記憶成績_vec,
                タイム = タイム_vec)
df




summary(df)




# 記述統計量(要約統計量、基本統計量)
mean(df$記憶成績)
round(sd(df$記憶成績), 3) # 不偏標準偏差でいい
length(df$記憶成績)

mean(df$タイム)
round(sd(df$タイム), 3) # 不偏標準偏差でいい
length(df$タイム)




# 相関係数と検定
cor(df$記憶成績, df$タイム)
round(cor(df$記憶成績, df$タイム), 2)
cor.test(df$記憶成績, df$タイム) # 95%信頼区間
cor.test(df$記憶成績, df$タイム, conf.level = 0.99) # 99%信頼区間
# p値はいずれも有意




# 回帰分析
lm1 <- lm(df$記憶成績 ~ df$タイム, data = df)
lm1
summary(lm1)
# 予測式
# 記憶成績 <- 19.291 - 0.915*タイム




#
# 結論
# 記憶成績と50m走タイムの平均値と(不偏)標準偏差を算出すると、
# 記憶成績は平均9.96(SD 2.85)、50m走タイムは平均10.20(SD 2.12)であった。
# 両者の相関係数は、r = -0.68であり、有意な負の相関がみられた。
#




#
# だがしかし...
#
# 以下、検討する。
#




# 散布図
#
# 文字化けするなら。
par(family = "Osaka")

plot(df$タイム, df$記憶成績,
    xlab = "タイム", ylab = "記憶成績")


# ggplot2
library("ggplot2")
theme_set(theme_grey(base_family = "Osaka"))

ggplot(df, aes(x = タイム, y = 記憶成績)) +
    geom_point() +
    geom_text(aes(label = 年齢), size = 4, hjust = -1) +
    annotate("text", x = 12, y = 14,
            label = "数字は年齢", family = "Osaka", colour = "steelblue", size = 10) # ここでまたfamilyでフォントを指定しないと日本語が文字化けする
# 散布図から検討する
#
# この調査の対象は、8~12歳の生徒であった。
# この年齢段階であれば、年齢が上がるほど記憶成績が上昇し、
# 50m走のタイムが短くなるのは当然ではないだろうか。
# ここから、疑似相関である可能性が考えられる。
#
# 偏相関係数を算出することと重回帰分析を行い明らかにしたほうがよい。
#





# 偏相関係数
# a = 年齢、b = タイム、y = 記憶成績
# a = 年齢、を統制(コントロール)したい場合
# 数式 (rby - (ray * rab)) / (sqrt(1 - ray^2) * sqrt(1 - rab^2))
r_ab <- cor(df$年齢, df$タイム)
r_ab

r_ay <- cor(df$年齢, df$記憶成績)
r_ay

r_by <- cor(df$タイム, df$記憶成績)
r_by

偏相関係数 <- (r_by - (r_ay * r_ab)) / ((sqrt(1 - r_ay^2)) * (sqrt(1 - r_ab^2)))
偏相関係数
round(偏相関係数, 2)
# 年齢を統制(コントロール)した記憶成績とタイムとの偏相関係数は、0.09であり、
# 有意ではなかった。
# つまり、疑似相関。
#




# 相関係数と検定
round(cor(df$記憶成績, df$年齢), 2)
cor.test(df$記憶成績, df$年齢)

round(cor(df$記憶成績, df$タイム), 2)
cor.test(df$記憶成績, df$タイム)

round(cor(df$年齢, df$タイム), 2)
cor.test(df$年齢, df$タイム)


# 重回帰分析
lm2 <- lm(df$記憶成績 ~ ., data = df)
lm2
summary(lm2)
# 記憶成績と年齢は、p値0.00179 **
# 記憶成績とタイムは、p値 0.68897
# このことから、記憶成績に影響を及ぼしているのは、年齢であることがわかる。
#




#
# 結論
# 記憶成績と50m走のタイムとの関連は、年齢という第3の変数(変量)の影響による疑似相関であったといえる。
# したがって、
# "生徒のなかで、足が速い子は記憶力も良いのではないか" は、主に年齢の問題であり、
# "ランニングをすれば、体力もつき、足にかかる負担が脳にも適度な刺激となり、
# 活性化し、記憶力も良くなるのではないか" は、この場合、意味があるとはいえない。
#

R Console

> #
> # R(R言語)で、相関係数を求め単回帰分析、それを検討するために散布図、偏相関係数、重回帰分析(疑似相関を考える)。
> #
> 
> 
> 
> 
> #
> # 使用するデータと解説は、『実践形式で学ぶ SPSSとAmosによる心理・調査データ解析』
> # Exercise 2 p.10~17
> #
> 
> 
> 
> 
> #
> # 書籍通りに従うと、
> # 相関係数、単回帰分析、散布図、偏相関係数、疑似相関、重回帰分析 の順
> # (ただし、書籍にある、分散分析と標準偏回帰係数は割愛)
> #
> 
> 
> 
> 
> #
> # 研究テーマと分析の背景
> #
> # "生徒のなかで、足が速い子は記憶力も良いのではないか"
> # "ランニングをすれば、体力もつき、足にかかる負担が脳にも適度な刺激となり、
> # 活性化し、記憶力も良くなるのではないか"
> # そこで、25名の生徒に記憶力テストを実施した。
> # また、体力測定結果から50メートル走のタイム(秒)を調べた。
> #
>
> 
> 
> 
> # 使用するデータ
> ID_vec <- c(1:25)
> 
> 年齢_vec <- c(10, 12, 11, 9, 8,
+             11, 12, 9, 8, 8,
+             11, 9, 10, 10, 8,
+             9, 9, 11, 10, 12,
+             12, 10, 8, 12, 11)
> 
> 記憶成績_vec <- c(10, 11, 11, 6, 8,
+                 14, 14, 11, 5, 6,
+                 13, 5, 11, 9, 9,
+                 8, 10, 11, 8, 13,
+                 11, 10, 7, 15, 13)
> 
> タイム_vec <- c(8, 8, 9, 11, 12,
+                 7, 8, 11, 13, 12,
+                 11, 11, 11, 12, 13,
+                 12, 13, 8, 9, 7,
+                 8, 10, 14, 8, 9)
> 
> df <- data.frame(年齢 = 年齢_vec,
+                 記憶成績 = 記憶成績_vec,
+                 タイム = タイム_vec)
> df
   年齢 記憶成績 タイム
1    10       10      8
2    12       11      8
3    11       11      9
4     9        6     11
5     8        8     12
6    11       14      7
7    12       14      8
8     9       11     11
9     8        5     13
10    8        6     12
11   11       13     11
12    9        5     11
13   10       11     11
14   10        9     12
15    8        9     13
16    9        8     12
17    9       10     13
18   11       11      8
19   10        8      9
20   12       13      7
21   12       11      8
22   10       10     10
23    8        7     14
24   12       15      8
25   11       13      9
> 
> 
> 
> 
> summary(df)
      年齢       記憶成績         タイム    
 Min.   : 8   Min.   : 5.00   Min.   : 7.0  
 1st Qu.: 9   1st Qu.: 8.00   1st Qu.: 8.0  
 Median :10   Median :10.00   Median :11.0  
 Mean   :10   Mean   : 9.96   Mean   :10.2  
 3rd Qu.:11   3rd Qu.:11.00   3rd Qu.:12.0  
 Max.   :12   Max.   :15.00   Max.   :14.0  
> 
> 
> 
> 
> # 記述統計量(要約統計量、基本統計量)
> mean(df$記憶成績)
[1] 9.96
> round(sd(df$記憶成績), 3) # 不偏標準偏差でいい
[1] 2.85
> length(df$記憶成績)
[1] 25
> 
> mean(df$タイム)
[1] 10.2
> round(sd(df$タイム), 3) # 不偏標準偏差でいい
[1] 2.121
> length(df$タイム)
[1] 25
> 
> 
> 
> 
> # 相関係数と検定
> cor(df$記憶成績, df$タイム)
[1] -0.6808827
> round(cor(df$記憶成績, df$タイム), 2)
[1] -0.68
> cor.test(df$記憶成績, df$タイム) # 95%信頼区間

    Pearson's product-moment correlation

data:  df$記憶成績 and df$タイム
t = -4.4585, df = 23, p-value = 0.0001795
alternative hypothesis: true correlation is not equal to 0
95 percent confidence interval:
 -0.8478972 -0.3909256
sample estimates:
       cor 
-0.6808827 

> cor.test(df$記憶成績, df$タイム, conf.level = 0.99) # 99%信頼区間

    Pearson's product-moment correlation

data:  df$記憶成績 and df$タイム
t = -4.4585, df = 23, p-value = 0.0001795
alternative hypothesis: true correlation is not equal to 0
99 percent confidence interval:
 -0.8809348 -0.2743753
sample estimates:
       cor 
-0.6808827 

> # p値はいずれも有意
> 
> 
> 
> 
> # 回帰分析
> lm1 <- lm(df$記憶成績 ~ df$タイム, data = df)
> lm1

Call:
lm(formula = df$記憶成績 ~ df$タイム, data = df)

Coefficients:
(Intercept)    df$タイム  
    19.2911      -0.9148  

> summary(lm1)

Call:
lm(formula = df$記憶成績 ~ df$タイム, data = df)

Residuals:
    Min      1Q  Median      3Q     Max 
-4.2281 -0.9726 -0.0578  1.7719  3.7719 

Coefficients:
            Estimate Std. Error t value Pr(>|t|)    
(Intercept)  19.2911     2.1359   9.032 5.03e-09 ***
df$タイム    -0.9148     0.2052  -4.459  0.00018 ***
---
Signif. codes:  0***0.001**0.01*0.05 ‘.’ 0.1 ‘ ’ 1

Residual standard error: 2.132 on 23 degrees of freedom
Multiple R-squared:  0.4636, Adjusted R-squared:  0.4403 
F-statistic: 19.88 on 1 and 23 DF,  p-value: 0.0001795

> # 予測式
> # 記憶成績 <- 19.291 - 0.915*タイム
> 
> 
> 
> 
> #
> # 結論
> # 記憶成績と50m走タイムの平均値と(不偏)標準偏差を算出すると、
> # 記憶成績は平均9.96(SD 2.85)、50m走タイムは平均10.20(SD 2.12)であった。
> # 両者の相関係数は、r = -0.68であり、有意な負の相関がみられた。
> #
> 
> 
> 
> 
> #
> # だがしかし...
> #
> # 以下、検討する。
> #
> 
> 
> 
> 
> # 散布図
> #
> # 文字化けするなら。
> par(family = "Osaka")
> 
> plot(df$タイム, df$記憶成績,
+     xlab = "タイム", ylab = "記憶成績")
> 
> 
> # ggplot2
> library("ggplot2")
> theme_set(theme_grey(base_family = "Osaka"))
> 
> ggplot(df, aes(x = タイム, y = 記憶成績)) +
+     geom_point() +
+     geom_text(aes(label = 年齢), size = 4, hjust = -1) +
+     annotate("text", x = 12, y = 14,
+             label = "数字は年齢", family = "Osaka", colour = "steelblue", size = 10) # ここでまたfamilyでフォントを指定しないと日本語が文字化けする
> # 散布図から検討する
> #
> # この調査の対象は、8~12歳の生徒であった。
> # この年齢段階であれば、年齢が上がるほど記憶成績が上昇し、
> # 50m走のタイムが短くなるのは当然ではないだろうか。
> # ここから、疑似相関である可能性が考えられる。
> #
> # 偏相関係数を算出することと重回帰分析を行い明らかにしたほうがよい。
> #
> 
> 
> 
> 
> 
> # 偏相関係数
> # a = 年齢、b = タイム、y = 記憶成績
> # a = 年齢、を統制(コントロール)したい場合
> # 数式 (rby - (ray * rab)) / (sqrt(1 - ray^2) * sqrt(1 - rab^2))
> r_ab <- cor(df$年齢, df$タイム)
> r_ab
[1] -0.8709297
> 
> r_ay <- cor(df$年齢, df$記憶成績)
> r_ay
[1] 0.8102746
> 
> r_by <- cor(df$タイム, df$記憶成績)
> r_by
[1] -0.6808827
> 
> 偏相関係数 <- (r_by - (r_ay * r_ab)) / ((sqrt(1 - r_ay^2)) * (sqrt(1 - r_ab^2)))
> 偏相関係数
[1] 0.08614716
> round(偏相関係数, 2)
[1] 0.09
> # 年齢を統制(コントロール)した記憶成績とタイムとの偏相関係数は、0.09であり、
> # 有意ではなかった。
> # つまり、疑似相関。
> #
> 
> 
> 
> 
> # 相関係数と検定
> round(cor(df$記憶成績, df$年齢), 2)
[1] 0.81
> cor.test(df$記憶成績, df$年齢)

    Pearson's product-moment correlation

data:  df$記憶成績 and df$年齢
t = 6.6307, df = 23, p-value = 9.153e-07
alternative hypothesis: true correlation is not equal to 0
95 percent confidence interval:
 0.6106532 0.9130722
sample estimates:
      cor 
0.8102746 

> 
> round(cor(df$記憶成績, df$タイム), 2)
[1] -0.68
> cor.test(df$記憶成績, df$タイム)

    Pearson's product-moment correlation

data:  df$記憶成績 and df$タイム
t = -4.4585, df = 23, p-value = 0.0001795
alternative hypothesis: true correlation is not equal to 0
95 percent confidence interval:
 -0.8478972 -0.3909256
sample estimates:
       cor 
-0.6808827 

> 
> round(cor(df$年齢, df$タイム), 2)
[1] -0.87
> cor.test(df$年齢, df$タイム)

    Pearson's product-moment correlation

data:  df$年齢 and df$タイム
t = -8.4997, df = 23, p-value = 1.493e-08
alternative hypothesis: true correlation is not equal to 0
95 percent confidence interval:
 -0.9419174 -0.7254482
sample estimates:
       cor 
-0.8709297 

> 
> 
> # 重回帰分析
> lm2 <- lm(df$記憶成績 ~ ., data = df)
> lm2

Call:
lm(formula = df$記憶成績 ~ ., data = df)

Coefficients:
(Intercept)         年齢       タイム  
     -9.215        1.777        0.138  

> summary(lm2)

Call:
lm(formula = df$記憶成績 ~ ., data = df)

Residuals:
    Min      1Q  Median      3Q     Max 
-3.2937 -1.2085  0.0676  1.3449  2.7063 

Coefficients:
            Estimate Std. Error t value Pr(>|t|)   
(Intercept)  -9.2148     8.2123  -1.122  0.27392   
年齢          1.7767     0.5002   3.552  0.00179 **
タイム        0.1380     0.3403   0.406  0.68897   
---
Signif. codes:  0***0.001**0.01*0.05 ‘.’ 0.1 ‘ ’ 1

Residual standard error: 1.738 on 22 degrees of freedom
Multiple R-squared:  0.6591, Adjusted R-squared:  0.6281 
F-statistic: 21.27 on 2 and 22 DF,  p-value: 7.227e-06

> # 記憶成績と年齢は、p値0.00179 **
> # 記憶成績とタイムは、p値 0.68897
> # このことから、記憶成績に影響を及ぼしているのは、年齢であることがわかる。
> #
> 
> 
> 
> 
> #
> # 結論
> # 記憶成績と50m走のタイムとの関連は、年齢という第3の変数(変量)の影響による疑似相関であったといえる。
> # したがって、
> # "生徒のなかで、足が速い子は記憶力も良いのではないか" は、主に年齢の問題であり、
> # "ランニングをすれば、体力もつき、足にかかる負担が脳にも適度な刺激となり、
> # 活性化し、記憶力も良くなるのではないか" は、この場合、意味があるとはいえない。
> #

散布図のスクリーンショット

f:id:my_notes:20170711172531p:plain

f:id:my_notes:20170711172546p:plain

参考文献

実践形式で学ぶSPSSとAmosによる心理・調査データ解析

実践形式で学ぶSPSSとAmosによる心理・調査データ解析