WAB05 #R - Qiita

データ解析基礎論 a weekly assignment B05

課題内容

WAB05.1

# データのインプットと可視化
dat <- read.csv("http://peach.l.chiba-u.ac.jp/course_folder/waa05.csv")
dat2<-dat[,1:3]
dat2$subj <- rep(paste("subj",1:50,sep =""),2)
interaction.plot(dat2$condition,  # x軸
                 dat2$medicine,    # まとめる変数　　　　
                 dat2$blood.pressure,    # y軸 
                 pch=c(20,20), 
                 col=c("skyblue","orange"),
                 ylab="Blood Pressure",
                 xlab="condition",
                 lwd=3,　
                 type='b',
                 cex=1.5,
                 trace.label="Medicine")

# anova
dat2.aov <- aov(blood.pressure ~ medicine + condition + medicine:condition + 
              　Error(subj + subj:medicine + subj:condition + subj:medicine:condition),
                data = dat2) 
dat2.aov.sum <- summary(dat2.aov)
dat2.aov.sum

# 出力結果
Error: subj
          Df Sum Sq Mean Sq F value Pr(>F)
Residuals 49   1706   34.82               

Error: subj:medicine
          Df Sum Sq Mean Sq F value   Pr(>F)    
medicine   1   7614    7614   126.3 3.61e-15 ***
Residuals 49   2953      60                     
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

Error: subj:condition
          Df Sum Sq Mean Sq F value Pr(>F)    
condition  1   8502    8502   815.4 <2e-16 ***
Residuals 49    511      10                   
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

Error: subj:medicine:condition
                   Df Sum Sq Mean Sq F value Pr(>F)    
medicine:condition  1   8554    8554   607.8 <2e-16 *** 　　　#交互作用が有意
Residuals          49    690      14                   
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

薬 A および薬 B が投薬後の血圧にどのような効果かを及ぼすか分散分析を行い検証した。
その結果、投薬前後と薬の種類の間で交互作用が有意であると示された。有意な交互作用が示されたため、単純主効果の検定を行う。

# 単純主効果の検定
dat.aov.sEffect <- aov(blood.pressure ~ condition*medicine + 
                       Error(subj + subj:medicine + subj:condition),
                       dat2)
summary(dat.aov.sEffect)
source("http://peach.l.chiba-u.ac.jp/course_folder/tsme.txt") 
TSME<-RBF.tsme(dat.aov.sEffect, dat2,"blood.pressure")

# 出力結果
simple main effect test for the 1st within-subject factor 
                 ss df       ms         f      p
Medicine A 17056.36  1 17056.36 1.392e+03 0.0000　  #薬Aの条件で投薬前後に有意な差がある  
Medicine B     0.04  1     0.04 3.265e-03 0.9545
residual    1200.60 98    12.25          

 Tukey HSD test - 1st within-subject factor @ medicine = Medicine A 
       pre  post
pre  FALSE  TRUE　　　　　　　　　　　　#投薬前と投薬後では有意な差がある
post  TRUE FALSE

 simple main effect test for the 2nd within-subject factor 
               ss df       ms        f      p
pre         13.69  1    13.69   0.3683 0.5453　　#投薬後には有意な差がある
post     16154.41  1 16154.41 434.5802 0.0000
residual  3642.90 98    37.17                

 Tukey HSD test - 2nd within-subject factor @ condition = post 
           Medicine A Medicine B          #投薬後では薬Aと薬Bに有意な差があった
Medicine A      FALSE       TRUE
Medicine B       TRUE      FALSE

薬Aにおいて、投薬前後で実験参加者の血圧に有意な差が示された。
また、投薬後において、薬Aと薬Bの間で血圧に有意な差が示された。

WAB05.2

# データのインプットと可視化
dat <- read.csv("http://peach.l.chiba-u.ac.jp/course_folder/w04.csv")
interaction.plot(dat$stimulus,  # x軸
                 dat$method,    # まとめる変数　　　　
                 dat$score,    # y軸 
                 pch=c(20,20,20), 
                 col=c("skyblue","orange","palegreen2"),
                 ylab="Score",
                 xlab="Stimulus",
                 lwd=3,　
                 type='b',
                 cex=1.5,
                 trace.label="Method")

# anova
dat.aov <- aov(score ~ stimulus + method + stimulus:method +  
               Error(subj + subj:method + subj:stimulus + subj:method:stimulus),
               data = dat)
dat.aov.sum <- summary(dat.aov)

# 出力結果
Error: subj
          Df Sum Sq Mean Sq F value Pr(>F)
Residuals  9  205.6   22.84               

Error: subj:method
          Df Sum Sq Mean Sq F value   Pr(>F)    
method     2 2319.1  1159.5   58.44 1.34e-08 ***
Residuals 18  357.1    19.8                     
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

Error: subj:stimulus
          Df Sum Sq Mean Sq F value  Pr(>F)    
stimulus   2   6763    3381   95.09 2.7e-10 ***
Residuals 18    640      36                    
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

Error: subj:method:stimulus
                Df Sum Sq Mean Sq F value Pr(>F)
stimulus:method  4   99.7   24.93   0.972  0.435　　#交互作用が有意でない
Residuals       36  923.4   25.65

方法と刺激が記憶・想起テストの点数にどのような効果を及ぼすか被験者内要因の分散分析を行い検証した。
その結果、方法要因と刺激要因の間で交互作用が有意であるとは示されなかった。
交互作用が有意でなかったため、多重比較を行なった。

# summaryの中身確認
str(dat.aov.sum)　
#　方法の多重比較
mse <- dat.aov.sum[[2]][[1]][[3]][2]
q <- qtukey(0.95,3,18)    #18はsubj:methodのDf
hsd <- q*sqrt(mse/15*3)   #(2/30)*3は(2*(1/被験者の数))*(もう一つの要因のグループ数) 
dat.mean.method <- tapply(dat$score,dat$method,mean)
gaiseki.method <- outer(dat.mean.method,dat.mean.method,'-')
abs(gaiseki.method) > hsd

# 出力結果
    A     B     C
A FALSE  TRUE FALSE
B  TRUE FALSE  TRUE
C FALSE  TRUE FALSE

#　刺激の多重比較
mse <- dat.aov.sum[[3]][[1]][[3]][2]
q <- qtukey(0.95,3,18)     #18はsubj:stimulusのDf
hsd <- q*sqrt(mse/15*3)    #(2/30)*3は(2*(1/被験者の数))*(もう一つの要因のグループ数) 
dat.mean.stimulus <- tapply(dat$score,dat$stimulus,mean)
gaiseki.stimulus <- outer(dat.mean.stimulus,dat.mean.stimulus,'-')
abs(gaiseki.stimulus) > hsd

# 出力結果
       english kanji symbol
english   FALSE  TRUE   TRUE
kanji      TRUE FALSE   TRUE
symbol     TRUE  TRUE  FALSE

多重比較を用いて、方法群および刺激群においてどの種類間に有意な差があるか検証した。
その結果、方法群においては、方法Aと方法B間・方法Bと方法C間で有意な差が示され、
刺激軍においては、英語と漢字間・英語とシンボル間・漢字とシンボル間に有意な差があることが示された。