本調査の Q4, Q5 のデータを用い、以下の要領で違和感を従属変数とした回帰分析をしなさい。なお、要因配置調査実験データの分析 の 1～6 や例題の解答例を参考にせよ。
前回の課題とほぼ同じなので、スクリプトは省略。回答者の所属大学をロングデータに含める点だけが異なるので注意。前回のスクリプトで言えば、d01 を作るときに d0 の 115列目も含める必要がある。変数名の付け替えの際も、この列に適当な名前（私は university とした）をつける必要がある。
| names.d01.long | |
|---|---|
| sex | Q1.あなたの性別は. |
| age | Q2.あなたの年齢は. |
| birthmonth | Q3.あなたは何月生まれですか.あてはまるものを一つ選んでください. |
| university | Q8.あなたが現在通っている大学を教えてください. |
| id | id |
| vignette | variable |
| discomfort | value |
##
## あまり違和感を感じない あまり感じない とても違和感を感じる
## 176 790 57
## とても感じる 違和感を感じない 少し違和感を感じる
## 377 2687 131
## 少し感じる
## 719## discomfort.n
## discomfort 0 1 2 3
## あまり違和感を感じない 0 176 0 0
## あまり感じない 0 790 0 0
## とても違和感を感じる 0 0 0 57
## とても感じる 0 0 0 377
## 違和感を感じない 2687 0 0 0
## 少し違和感を感じる 0 0 131 0
## 少し感じる 0 0 719 0うまくいったら、ロングデータに以下のような変数ができる。
table(d01.long$university) # ヴィネットの数だけサンプルサイズが増えている点に注意##
## 愛知工科大学 宇都宮大学 岡山大学 関西医科大学 久留米大学
## 72 72 72 72 72
## 京都女子大学 京都大学 京都府立大学 金城学院大学 九州大学
## 288 10440 72 864 72
## 香川大学 高知大学 社会人 神戸大学 早稲田大学
## 72 72 72 72 72
## 大阪 大阪公立大学 大阪大学 電大 東京大学
## 72 72 216 72 72
## 東京理科大学 東洋大学 同志社 同志社女子 同志社大学
## 72 72 72 72 216
## 北海道教育大学 北海道大学 名古屋工業大学 名古屋大学 名城大学
## 72 72 72 144 72
## 立命館大学
## 288回答者の年齢を連続変数に変換
table(d01.long$age)##
## 18歳以下 19 20 21 22 23 24 25
## 792 2088 3096 4104 3168 432 648 144
## 26 31歳以上
## 216 144age.temp <- substring(d01.long$age, 1, 2) # 1～2文字目だけとってくる
table(age.temp) # うまくいったか確認## age.temp
## 18 19 20 21 22 23 24 25 26 31
## 792 2088 3096 4104 3168 432 648 144 216 144class(age.temp) # 文字列になっている## [1] "character"summary(age.temp) # 文字列だと平均などが計算されない## Length Class Mode
## 14832 character characterd01.long$age.n <- as.numeric(age.temp) # 数値に変換
summary(d01.long$age.n)## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 18.00 20.00 21.00 20.96 22.00 31.00性別も基準カテゴリを女性にしておく（その他が基準カテゴリになっているので変更）。
table(d01.long$sex)##
## その他 女性 男性
## 288 7272 7272d01.long$sex <- factor(d01.long$sex, levels = c("女性", "男性", "その他"))
table(d01.long$sex) # 指定した順番に表示されるか確認。##
## 女性 男性 その他
## 7272 7272 288京大ダミーを作る。
unique(d01.long$university) # どんな回答があるか確認## [1] "電大" "宇都宮大学" "名古屋工業大学" "名古屋大学"
## [5] NA "東京大学" "早稲田大学" "高知大学"
## [9] "京都大学" "久留米大学" "同志社大学" "香川大学"
## [13] "京都女子大学" "岡山大学" "東洋大学" "愛知工科大学"
## [17] "社会人" "名城大学" "北海道教育大学" "東京理科大学"
## [21] "立命館大学" "関西医科大学" "同志社女子" "同志社"
## [25] "大阪大学" "大阪" "大阪公立大学" "神戸大学"
## [29] "九州大学" "京都府立大学" "北海道大学" "金城学院大学"table(is.na(d01.long$university)) # NAの数を確認。TRUEが無回答##
## FALSE TRUE
## 14184 648d01.long$kyodai <- d01.long$university == "京都大学" # 京都大学の時 TRUE をとるダミー変数
summary(d01.long$kyodai)## Mode FALSE TRUE NA's
## logical 3744 10440 648回帰分析する
| Model 1 | Model 2 | Model 3 | |
|---|---|---|---|
| (Intercept) | -0.03 | -0.06 | -0.07 |
| (0.05) | (0.15) | (0.37) | |
| tasteアニメ | 0.69*** | 0.69*** | 0.69*** |
| (0.05) | (0.05) | (0.05) | |
| tasteお菓子作り | -0.48*** | -0.48*** | -0.49*** |
| (0.07) | (0.07) | (0.06) | |
| tasteカフェ巡り | -0.43*** | -0.47*** | -0.47*** |
| (0.07) | (0.07) | (0.06) | |
| tasteバイク | 0.22** | 0.18** | 0.18** |
| (0.07) | (0.07) | (0.06) | |
| tasteバレエ | -0.02 | -0.06 | -0.06 |
| (0.07) | (0.07) | (0.06) | |
| tasteヨガ | -0.23*** | -0.25*** | -0.23*** |
| (0.07) | (0.07) | (0.06) | |
| tasteラグビー | 0.87*** | 0.84*** | 0.87*** |
| (0.07) | (0.07) | (0.06) | |
| tasteロックバンド | -0.39*** | -0.38*** | -0.37*** |
| (0.05) | (0.05) | (0.05) | |
| taste服 | 0.79*** | 0.79*** | 0.80*** |
| (0.05) | (0.05) | (0.05) | |
| taste麻雀 | 0.27*** | 0.29*** | 0.31*** |
| (0.07) | (0.07) | (0.06) | |
| taste漫画 | 0.29*** | 0.28*** | 0.29*** |
| (0.05) | (0.05) | (0.05) | |
| taste野球 | 0.44*** | 0.44*** | 0.44*** |
| (0.07) | (0.07) | (0.06) | |
| sex.v男 | 0.63*** | 0.63*** | 0.63*** |
| (0.03) | (0.03) | (0.03) | |
| age.v | 0.01*** | 0.01*** | 0.01*** |
| (0.00) | (0.00) | (0.00) | |
| sex男性 | 0.13*** | 0.13* | |
| (0.03) | (0.07) | ||
| sexその他 | -0.24** | -0.24 | |
| (0.09) | (0.23) | ||
| age.n | -0.01 | -0.01 | |
| (0.01) | (0.02) | ||
| kyodaiTRUE | 0.15*** | 0.15 | |
| (0.03) | (0.08) | ||
| R2 | 0.23 | 0.24 | |
| Adj. R2 | 0.22 | 0.24 | |
| Num. obs. | 4937 | 4721 | 4721 |
| AIC | 11481.71 | ||
| BIC | 11617.36 | ||
| Log Likelihood | -5719.85 | ||
| Num. groups: id | 197 | ||
| Var: id (Intercept) | 0.19 | ||
| Var: Residual | 0.60 | ||
| ***p < 0.001; **p < 0.01; *p < 0.05 | |||