Code
2options(digits = 3)
if (!require("pacman")) install.packages("pacman")
pacman::p_load(tidyverse, magrittr, ggpubr, here,
car, modelsummary, datarium, dae, ggdist)
- 2
- 必要なパッケージを読み込み
2024/07/26
2options(digits = 3)
if (!require("pacman")) install.packages("pacman")
pacman::p_load(tidyverse, magrittr, ggpubr, here,
car, modelsummary, datarium, dae, ggdist)
調査者が何らかの操作をして行う調査・研究
参加者をランダムに2つ(以上)のグループに割り振って,片方には新しい薬を,片方には薬ではないもの(プラセボ)を投与して,新薬の効果を検証する
同じ場所に並べた複数の植木のうち,ランダムに選んだいくつかには肥料を与え,残りには与えないことで,肥料の効果を検証する
アクセスしてくる人のうち一定割合に別のデザインの画面を表示し,クリックする先やクリック率等を比較する。(どちらのデザインの方が良いか?)
実験的手法は,調査者が何らかの介入をして,その介入効果を見るようなもの。そのような特徴から
元々理系では実験的手法が中心だったけれど,上記の特徴から社会科学領域でも実験的研究が重視されてきている。2019年のノーベル経済学賞をとったBanerjee, Duflo, Kremerも「世界の貧困を改善するための実験的アプローチに関する功績」
一方で,
xがyの原因となる
「国民健康・栄養調査」による年齢別の身長・体重データ
Call:
lm(formula = Height_m ~ Weight_m, data = height_weight)
Residuals:
Min 1Q Median 3Q Max
-19.02 -6.79 1.33 6.58 12.11
Coefficients:
Estimate Std. Error t value Pr(>|t|)
(Intercept) 84.7973 2.4348 34.8 <2e-16 ***
Weight_m 1.3391 0.0464 28.9 <2e-16 ***
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Residual standard error: 7.61 on 60 degrees of freedom
Multiple R-squared: 0.933, Adjusted R-squared: 0.932
F-statistic: 834 on 1 and 60 DF, p-value: <2e-16
身長と体重は有意に正の関係がある。
でも,これは明らかに因果関係ではない。
おそらく単なる相関関係
偶然相関があるように見える
人口あたりのチーズの消費量とベッドシーツに絡まって死ぬ人の数
アメリカの科学・宇宙・テクノロジーに対する支出と首吊り,絞殺,窒息による自殺者数
つまり…
単に相関を計算したり,回帰分析をしただけではx → yという因果関係はわからない。
因果関係を推論することは結構難しい。
仮に薬の効果を知りたいとしたら,薬を投与した人と投与しない人1人ずつのその効果(例えば血液検査の結果数値など)を比べる?
適切な比較はできない
本来的には薬の効果(薬と症状改善の因果関係)は「同じ人が投与した場合と投与していない場合」を比較しないといけない。
でも,現実に観察されるのはどっちか。薬ありもしくは薬なしどっちかのデータしか取れない。
パラレルワールド・タイムマシンがない限り実現できない。反実仮想が必要。
因果推論の根本問題とか言われる
たくさんの参加者を集めて,その人たちにランダムに処置(投与するかしないか)を割り振る
ランダムに割り振った集団間の比較をすることで薬の「平均的な」効果を推定することができる
個人レベルで見ると因果関係はそもそも検証が不可能
集団レベルでランダムに処置を割り振ることで,平均的な効果の推定を通した因果関係が可能
このことを使って
参考: エビデンスレベル
Level | 内容 |
---|---|
1a | ランダム化比較試験のメタアナリシス |
1b | 少なくとも一つのランダム化比較試験 (RCT) |
2a | ランダム割付を伴わない同時コントロールを伴うコホート研究(前向き研究、prospective study, concurrent cohort study) |
2b | ランダム割付を伴わない過去のコントロールを伴うコホート研究 (historical cohort study, retrospective cohort study) |
3 | 症例対照研究(ケースコントロール、後ろ向き研究) |
4 | 処置前後の比較の前後比較、対照群を伴わない研究 |
5 | 症例報告、ケースシリーズ |
6 | 専門家個人の意見(専門家委員会報告を含む) |
Rにサンプルデータとして入っているheadache
データを使用
ある製薬会社が片頭痛患者を対象に3種類の治療法を試験した。実験には72人の参加者が登録された。その目的は、片頭痛エピソードに関連する痛みのスコアを下げる新しいクラスの治療法の可能性を調べることである。
参加者は男性36名、女性36名である。男性と女性はさらに(等しく)片頭痛のリスクが低いか高いかに細分化された。
以下の変数を含む:
gender
性別: 「男性」と「女性」;
risk
リスク: 低 “と”高”
treatment
治療の種類:3つのカテゴリーがある: X”、“Y”、“Z”の3つのカテゴリーがある。
data("headache")
headache <- headache |>
filter(treatment != "Y") |>
mutate(treatment = as.character(treatment),
1 treatment = factor(treatment))
分析例を簡単にするため,treatment Yを落とした。なので,Xを治療なし,Zを薬による治療と解釈して話を進める
記述統計を見ると,gender
(男女)とrisk
(高い低い)は各条件に均等に配分されている
X (N=24) | Z (N=24) | ||||||
---|---|---|---|---|---|---|---|
Mean | Std. Dev. | Mean | Std. Dev. | Diff. in Means | p | ||
pain_score | 80.5 | 8.6 | 76.2 | 5.9 | -4.2 | 0.054 | |
N | Pct. | N | Pct. | ||||
gender | male | 12 | 50.0 | 12 | 50.0 | ||
female | 12 | 50.0 | 12 | 50.0 | |||
risk | high | 12 | 50.0 | 12 | 50.0 | ||
low | 12 | 50.0 | 12 | 50.0 |
主な分析は分散分析(ANOVA)。Anova(lm(結果 ~ 要因, data = データ名))
コマンドで実行可能
(僕は二重括弧が嫌いなので以下のように分けます)
仮説検定での帰無仮説は治療の効果はない。治療の違いの効果は10%水準で有意(\(F_{1,46}\) =3.946, p = 0.053 ; 水準を10%としたら,関係ないと言う帰無仮説は棄却される)
ANOVAの原理はダミー変数を使った回帰分析と一緒。なので以下のような単回帰分析をしても同じ
Call:
lm(formula = pain_score ~ treatment, data = headache)
Residuals:
Min 1Q Median 3Q Max
-12.09 -5.62 -1.17 4.40 19.55
Coefficients:
Estimate Std. Error t value Pr(>|t|)
(Intercept) 80.45 1.50 53.62 <2e-16 ***
treatmentZ -4.22 2.12 -1.99 0.053 .
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Residual standard error: 7.35 on 46 degrees of freedom
Multiple R-squared: 0.079, Adjusted R-squared: 0.059
F-statistic: 3.95 on 1 and 46 DF, p-value: 0.053
更に,性別やそもそもの頭痛リスクを踏まえた分析をしてみる
また,ggline()
コマンドを使うと,効果を図に表せる
男女で効き目が違うか
男性の方が効果が大きい。ただし交互作用が有意とまではいかない(\(F_{1,44}\) =2.439, p = 0.126 )
treatment, gender, riskはそれぞれ頭痛の度合いと有意に関係
treatment
とrisk
とgender
の3要因に交互作用
int <- interaction.ABC.plot(data = headache,
1 response = pain_score,
x.factor = treatment,
groups.factor = gender,
trace.factor = risk)
interaction.ABC.plot
(dae
パッケージ)を使うと比較的簡単にかける
回帰分析の結果を並べるとこんな感じ
list(
m1 <- lm(pain_score ~ treatment ,
data = headache),
m2 <- lm(pain_score ~ treatment + gender,
data = headache),
m3 <- lm(pain_score ~ treatment * gender,
data = headache),
m4 <- lm(pain_score ~ treatment + risk,
data = headache),
m5 <- lm(pain_score ~ treatment * risk,
data = headache),
m6 <- lm(pain_score ~ treatment + gender + risk,
data = headache),
m7 <- lm(pain_score ~ treatment * gender * risk,
data = headache)
) |>
msummary(models = _,
stars = TRUE,
gof_omit = "Log.Lik.|AIC|BIC|RMSE|F",
statistic = NULL)
(1) | (2) | (3) | (4) | (5) | (6) | (7) | |
---|---|---|---|---|---|---|---|
+ p < 0.1, * p < 0.05, ** p < 0.01, *** p < 0.001 | |||||||
(Intercept) | 80.453*** | 82.839*** | 84.395*** | 85.188*** | 85.802*** | 87.574*** | 92.739*** |
treatmentZ | -4.215+ | -4.215* | -7.327* | -4.215* | -5.444* | -4.215** | -13.058*** |
genderfemale | -4.773* | -7.885** | -4.773** | -13.874*** | |||
treatmentZ × genderfemale | 6.224 | 15.228*** | |||||
risklow | -9.469*** | -10.698*** | -9.469*** | -16.687*** | |||
treatmentZ × risklow | 2.458 | 11.462** | |||||
genderfemale × risklow | 11.978** | ||||||
treatmentZ × genderfemale × risklow | -18.009*** | ||||||
Num.Obs. | 48 | 48 | 48 | 48 | 48 | 48 | 48 |
R2 | 0.079 | 0.180 | 0.223 | 0.478 | 0.484 | 0.579 | 0.729 |
R2 Adj. | 0.059 | 0.144 | 0.170 | 0.454 | 0.449 | 0.550 | 0.681 |
ハンバーガー統計学を参考に作成
統制群 | 新フォーマット群 | |
会計知識高 | 7, 8, 6, 8, 10, 7, 8, 8, 9, 7 | 8, 9, 10, 10, 8, 8, 9, 7, 10, 8 |
会計知識低 | 4, 6, 5, 4, 3, 7, 5, 6, 4, 5 | 8, 7, 8, 6, 9, 7, 8, 8, 10, 8 |
(1) この検定での帰無仮説を言いなさい。
(2) この検定での対立仮説を言いなさい。
(3) 4つの条件におけるそれぞれの平均と標準偏差を計算しなさい(コードと結果)。
(4) 分散分析を行いなさい(コード)。
(5) 有意水準を1%としたとき、この分散分析表から言えることを書きなさい。
(6) 以上の検定の結果を、わかりやすいことばで説明しなさい。
次ページにデータ作成用コマンドがあります。
データ作成
score <- c(7, 8, 6, 8, 10, 7, 8, 8, 9, 7,
8, 9, 10, 10, 8, 8, 9, 7, 10, 8,
4, 6, 5, 4, 3, 7, 5, 6, 4, 5,
8, 7, 8, 6, 9, 7, 8, 8, 10, 8)
knowledge <- c(1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0)
format <-c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
kadai <- tibble(score, knowledge, format) %>%
mutate(knowledge = factor(knowledge,
levels = c(1, 0),
labels = c("high", "low")),
format = factor(format,
levels = c(1, 0),
labels = c("new", "normal")))
2024経営データ分析(会計)