library(tidyverse)
library(GDAtools) # ver2.0を使うこと
library(vcdExtra)
library(patchwork)
library(showtext)
showtext_auto(TRUE)##
1 概要
このスクリプトは、SSM2005の留置A票の設問、問16にある男女役割分担意識で回答空間を作成し、それを年齢、性別で構造分析した。
SSM2005のデータはSSJDAに申請して取得したものである。 LabeledSPSSで提供されたデータをhaven::read_sav で読み込み、Rのdataframeとして展開した。
最初に、各設問の分布を確認した。
今回のMCAの実例としては、留置A票の問16：男女役割意識に関する設問三つをアクティブ変数として選択しこれをもちいて、データ空間を生成する。
変数空間を確認すれば、第一軸の左側にリベラル度合が大(回答コードが４)、右側に、リベラル度合が小（回答コード３、２）。第二軸の下方向に、伝統的意識（回答コード１）が展開している。こうした、分布は、ワークショップなどの全体的に良好の解答が寄せられる分布にも見られる。一つの軸上に極端な選択（ここでは４と１）が並ぶのではなく、４と２３、２３と１というように、中間的な意思が見られるパターンである。
このデータ空間の構造を、性別および年齢で分析した。最後に、性別-年齢の交互作用を確認したが、交互作用はない。
2 はじめに
このスクリプトは、SSM2005の留置A票の設問、問16にある男女役割分担意識で回答空間を作成し、それを年齢、性別で構造分析する。
なお、MCAの処理については、(Le Roux et al. 2021)を参照のこと。
2.1 調査票（留置A票）
調査票は、以下から取得できる。
2.2 履歴
- ver0.81 2023/03/20
- ver0.8 2023/03/18
3 処理の準備
3.1 必要なパッケージのロード
3.2 データのロード
- このssm2005.rdaは、SPSS_haven_V2.RmdでSSM2005のsavをRのdataframeとして保存したものである。
load("ssm2005.rda")
.d2 <- ssm20054 MCAを行う対象変数を選択する
.d2 %>% select(q01_1,q01_2a,a16a,a16b,a16c) %>% na.omit() %>%
mutate(Age10=factor(str_c(10*floor(as.numeric(as.character(q01_2a))/10),"代"))) %>%
select(-q01_2a) -> A16abc.df5 データの基本集計：度数分布
調査票との対応は以下の通り
- 問16
+ 「ア）男性は外で働き、女性は家庭を守るべきである」 → Q16a
+ 「イ）男の子と女の子は違った育て方をすべきである」 → Q16b
+ 「ウ）家事や育児には、男性よりも女性が向いている」 → Q16c
- 回答
- 1 そう思う
- 2 どちらかといえばそう思う
- 3 どちらかといえばそう思わない
- 4 そう思わない
- 9 わからないA16abc.df %>% count(a16a) %>% mutate(rate=round(100*n/sum(n),1)) -> a16a.tbl
a16a.tbl %>% knitr::kable()
a16a.tbl %>% ggplot(aes(x=a16a,y=rate)) + geom_col(fill="lightblue") -> p1
A16abc.df %>% count(a16b) %>% mutate(rate=round(100*n/sum(n),1)) -> a16b.tbl
a16b.tbl%>% knitr::kable()
a16b.tbl %>% ggplot(aes(x=a16b,y=rate)) + geom_col(fill="lightblue") -> p2
A16abc.df %>% count(a16c) %>% mutate(rate=round(100*n/sum(n),1)) -> a16c.tbl
a16c.tbl%>% knitr::kable()
a16c.tbl %>% ggplot(aes(x=a16c,y=rate)) + geom_col(fill="lightblue") -> p3| a16a | n | rate |
|---|---|---|
| 1 | 246 | 8.7 |
| 2 | 727 | 25.7 |
| 3 | 677 | 23.9 |
| 4 | 1057 | 37.4 |
| 9 | 120 | 4.2 |
| a16b | n | rate |
|---|---|---|
| 1 | 277 | 9.8 |
| 2 | 754 | 26.7 |
| 3 | 647 | 22.9 |
| 4 | 985 | 34.8 |
| 9 | 164 | 5.8 |
| a16c | n | rate |
|---|---|---|
| 1 | 572 | 20.2 |
| 2 | 1141 | 40.4 |
| 3 | 418 | 14.8 |
| 4 | 545 | 19.3 |
| 9 | 151 | 5.3 |
p1 + p2 + p3 + plot_layout(nrow = 1, byrow = TRUE)
6 多重対応分析MCA
6.1 specificMCAのためのpassiveカテゴリ番号を取得する
- コード９の「わからない」を除外してMCA（specificMCA）を行うためのexcludeリストの作成
getindexcat(A16abc.df[,2:4]) %>% str_detect(".9") %>% which(TRUE) -> excl_list6.2 speMCAを実行
A16abc.df[,] %>% names[1] "q01_1" "a16a" "a16b" "a16c" "Age10"res.speMCA <- speMCA(A16abc.df[,2:4],excl = excl_list)6.3 固有値を確認する
data.frame(軸=1:3, 修正寄与率=res.speMCA$eig$mrate,累積修正寄与率=res.speMCA$eig$cum.mrate) -> eig_tbl
eig_tbl %>% knitr::kable()| 軸 | 修正寄与率 | 累積修正寄与率 |
|---|---|---|
| 1 | 53.48 | 53.48 |
| 2 | 38.94 | 92.42 |
| 3 | 7.58 | 100.00 |
eig_tbl %>%
ggplot(aes(x=軸,y=修正寄与率)) + geom_col(fill="lightblue") +
geom_line(aes(y=累積修正寄与率)) + geom_point(aes(y=累積修正寄与率)) +
geom_text(aes(y=累積修正寄与率 + 5,label=累積修正寄与率)) +
ggtitle("screeplot")
上の表、グラフより明らかなように、第１軸で、53.5%、２軸まで加えると、92%が体現されていることがわかる。以上から、1−2軸平面を分析すればよい。
6.4 変数雲、個体雲を描画
ggcloud_variables(res.speMCA) -> pv12
pv12 + coord_fixed(ratio = 1)
ggcloud_indiv(res.speMCA) -> pi12
pi12 + coord_fixed(ratio = 1)
tabcontrib(res.speMCA,dim = 1,best = TRUE) Variable Category Weight Contribution (left) Contribution (right)
2 a16a 4 1057 20.58
1 2 727 8.57
4 a16c 4 545 25.95
3 a16b 4 985 20.71
Total contribution Cumulated contribution Contribution of deviation
2 29.14 29.14 26.51
1
4 25.95 55.09 25.95
3 20.71 75.8 20.71
Proportion to variable
2 77.74
1
4 78.51
3 63.03tabcontrib(res.speMCA,dim = 2,best = TRUE) Variable Category Weight Contribution (left) Contribution (right)
1 a16a 1 246 26.86
2 3 677 8.45
4 a16c 1 572 23.86
3 a16b 1 277 22.41
Total contribution Cumulated contribution Contribution of deviation
1 35.31 35.31 35.28
2
4 23.86 59.17 23.86
3 22.41 81.58 22.41
Proportion to variable
1 99.71
2
4 70.27
3 73.066.5 変数空間で変数内カテゴリを順序あるものとしてlineでつなぐ
- groupは、pv12$data を開いて確認できる。
pv12 + geom_path(aes(group= groups,color=groups),lty=2) + coord_fixed(ratio = 1)
ggcloud_variables(res.speMCA,prop = "ctr.cloud")+coord_fixed(ratio = 1)
ggcloud_variables(res.speMCA,prop = "ctr1")+coord_fixed(ratio = 1)
ggcloud_variables(res.speMCA,prop = "ctr2")+coord_fixed(ratio = 1)
6.6 性別で集中楕円を描画
ggadd_kellipses(p=pi12,resmca = res.speMCA,var=A16abc.df$q01_1) + coord_fixed(ratio = 1)
6.7 年代で集中楕円を描画
ggadd_kellipses(p=pi12,resmca = res.speMCA,var=A16abc.df$Age10) + coord_fixed(ratio = 1)
ggadd_supvars(p=pv12,resmca = res.speMCA,A16abc.df[,c(1,5)]) + coord_fixed(ratio = 1)
6.8 性別-年代の交互作用を確認する
p <- ggcloud_variables(res.speMCA, col='lightgrey', shapes=FALSE) + coord_fixed(ratio = 1)
ggadd_interaction(p, res.speMCA, A16abc.df$q01_1, A16abc.df$Age10, col=c("tomato3","dodgerblue3"), legend="none") 
7 subsetMCA
A16abc.df[,] %>% names[1] "q01_1" "a16a" "a16b" "a16c" "Age10"res.speMCA2 <- speMCA(A16abc.df[,2:4])
getindexcat(A16abc.df[,2:4]) %>% str_detect("\\.9") %>% which(TRUE) -> excl_list1
getindexcat(A16abc.df[,2:4]) %>% str_detect("\\.4") %>% which(TRUE) -> excl_list2
getindexcat(A16abc.df[,2:4]) %>% str_detect("\\.1") %>% which(TRUE) -> excl_list3
res.speMCA3 <- speMCA(A16abc.df[,2:4],excl=c(excl_list1,excl_list2))
ggcloud_variables(res.speMCA3)
ggcloud_indiv(res.speMCA3)
res.speMCA4 <- speMCA(A16abc.df[,2:4],excl=c(excl_list1,excl_list3))
ggcloud_variables(res.speMCA4)
ggcloud_indiv(res.speMCA4)
8
getindexcat(A16abc.df[,2:4]) %>% str_detect("\\.2|\\.3") %>% which(TRUE) -> excl_list4
res.speMCA5 <- speMCA(A16abc.df[,2:4],excl=c(excl_list1,excl_list4))
ggcloud_variables(res.speMCA5)
ggcloud_indiv(res.speMCA5)
p <- ggcloud_variables(res.speMCA5, col='lightgrey', shapes=FALSE) + coord_fixed(ratio = 1)
ggadd_interaction(p, res.speMCA5, A16abc.df$q01_1, A16abc.df$Age10, col=c("tomato3","dodgerblue3"), legend="none") Warning: ggrepel: 4 unlabeled data points (too many overlaps). Consider
increasing max.overlaps
9 参考文献
Le Roux, Brigitte, Henry Rouanet, 大隅昇, 小野裕亮, and 鳰真紀子. 2021. 多重対応分析. 東京: オーム社.