library(tidyverse)
library(GDAtools)
library(vcd)
library(ggrepel)
library(showtext)
showtext_auto(TRUE)lname=load("res_mca.rda")
load("df_mca2.rda")ggcloud_indiv(resmca = res_mca) + coord_fixed(ratio = 1) -> pi12
ggcloud_indiv(resmca = res_mca,col = "grey") + coord_fixed(ratio = 1) -> pi12.grey
ggcloud_variables(resmca = res_mca) + coord_fixed(ratio = 1) -> pv12
ggcloud_variables(resmca = res_mca,col = "grey") + coord_fixed(ratio = 1) -> pv12.greynames(df_mca2)## [1] "run" "ID" "美術鑑賞" "図書館"
## [5] "舞台鑑賞" "学歴" "父学歴" "母学歴"
## [9] "世帯年収" "金融資産" "相続_金融資産" "相続_住宅"
## [13] "相続_土地" "相続_田畑" "相続_美術品" "相続_その他"
## [17] "相続_なし" "性別" "働き方" "仕事内容"
## [21] "役職"ggadd_supvars(p=pv12.grey,resmca=res_mca,vars = df_mca2[,c(18,20)])
ggadd_supvar(p=pv12.grey,resmca=res_mca,var = df_mca2[,20])
df_mca2 %>% mutate(性別仕事内容=str_c(性別,仕事内容,sep="_")) -> df_mca3#%>% str("性別仕事内容")
df_mca3 %>% names## [1] "run" "ID" "美術鑑賞" "図書館"
## [5] "舞台鑑賞" "学歴" "父学歴" "母学歴"
## [9] "世帯年収" "金融資産" "相続_金融資産" "相続_住宅"
## [13] "相続_土地" "相続_田畑" "相続_美術品" "相続_その他"
## [17] "相続_なし" "性別" "働き方" "仕事内容"
## [21] "役職" "性別仕事内容"df_mca3[,22] %>% head## [1] "男性_専門職・技術職" "女性_販売職" "男性_無回答"
## [4] "男性_専門職・技術職" "男性_専門職・技術職" "女性_専門職・技術職"なぜか描画されない…
ggadd_supvar(p=pv12.grey,resmca=res_mca,var = df_mca3[,22])
うまくいかないので、個別に座標を計算する
df_mca2 %>% names## [1] "run" "ID" "美術鑑賞" "図書館"
## [5] "舞台鑑賞" "学歴" "父学歴" "母学歴"
## [9] "世帯年収" "金融資産" "相続_金融資産" "相続_住宅"
## [13] "相続_土地" "相続_田畑" "相続_美術品" "相続_その他"
## [17] "相続_なし" "性別" "働き方" "仕事内容"
## [21] "役職"cbind(res_mca$ind$coord[,1:3],df_mca3[,18:22]) -> ind_coor_sup
names(ind_coor_sup)## [1] "dim.1" "dim.2" "dim.3" "性別" "働き方"
## [6] "仕事内容" "役職" "性別仕事内容"ind_coor_sup %>% group_by(性別) %>% summarize_at(.vars = 1:3,mean)## # A tibble: 3 × 4
## 性別 dim.1 dim.2 dim.3
## <fct> <dbl> <dbl> <dbl>
## 1 その他 -0.205 -0.104 -0.0498
## 2 男性 0.0461 0.0471 0.0270
## 3 女性 -0.0333 -0.0368 -0.0213ind_coor_sup %>% group_by(性別仕事内容) %>% summarize_at(.vars = 1:3,mean)## # A tibble: 24 × 4
## 性別仕事内容 dim.1 dim.2 dim.3
## <chr> <dbl> <dbl> <dbl>
## 1 その他_その他 -0.509 -0.470 -0.442
## 2 その他_サービス職 -0.0437 -0.0808 -0.0527
## 3 その他_事務職 -0.177 -0.179 0.0455
## 4 その他_専門職・技術職 -0.191 -0.0722 0.133
## 5 その他_無回答 -0.230 -0.0347 -0.161
## 6 その他_販売職 -0.245 -0.124 0.0649
## 7 女性_その他 -0.0894 -0.0213 -0.0421
## 8 女性_サービス職 -0.132 0.00792 -0.0133
## 9 女性_事務職 0.0151 -0.0687 0.00669
## 10 女性_専門職・技術職 0.119 -0.130 -0.0123
## # ℹ 14 more rowsクロス集計を確認
ind_coor_sup %>% xtabs(~ 仕事内容 + 性別,.,) -> .tbl0
.tbl0 %>% prop.table(margin = 1) %>% round(2)## 性別
## 仕事内容 その他 男性 女性
## 無回答 0.03 0.23 0.73
## 専門職・技術職 0.01 0.49 0.51
## 管理職 0.00 0.88 0.12
## 事務職 0.01 0.27 0.72
## 販売職 0.03 0.50 0.47
## サービス職 0.03 0.36 0.62
## 生産現場職・技能職 0.00 0.74 0.26
## 運輸・保安職 0.00 0.88 0.12
## その他 0.01 0.40 0.59#ind_coor_sup %>% xtabs(~ 性別 + 仕事内容,.,) -> .tbl
.tbl0 %>% chisq.test()## Warning in chisq.test(.): カイ自乗近似は不正確かもしれません##
## Pearson's Chi-squared test
##
## data: .
## X-squared = 240.01, df = 16, p-value < 2.2e-16.tbl0[2:3,] %>% chisq.test()## Warning in chisq.test(.): カイ自乗近似は不正確かもしれません##
## Pearson's Chi-squared test
##
## data: .
## X-squared = 55.023, df = 2, p-value = 1.127e-12vcd::mosaic(.tbl0,shade=TRUE, rot_labels = c(left = 0, top = 45,right=0),main="性別（その他込）仕事内容")
vcd::mosaic(.tbl0[,2:3],shade=TRUE, rot_labels = c(left = 0, top = 45,right=0),,main="性別（男女）仕事内容",keep_aspect_ratio=TRUE)
ind_coor_sup %>% count(性別,仕事内容) ## 性別 仕事内容 n
## 1 その他 無回答 7
## 2 その他 専門職・技術職 3
## 3 その他 事務職 3
## 4 その他 販売職 3
## 5 その他 サービス職 3
## 6 その他 その他 1
## 7 男性 無回答 52
## 8 男性 専門職・技術職 172
## 9 男性 管理職 101
## 10 男性 事務職 73
## 11 男性 販売職 54
## 12 男性 サービス職 43
## 13 男性 生産現場職・技能職 56
## 14 男性 運輸・保安職 45
## 15 男性 その他 45
## 16 女性 無回答 163
## 17 女性 専門職・技術職 179
## 18 女性 管理職 14
## 19 女性 事務職 191
## 20 女性 販売職 50
## 21 女性 サービス職 74
## 22 女性 生産現場職・技能職 20
## 23 女性 運輸・保安職 6
## 24 女性 その他 67ind_coor_sup %>% group_by(性別仕事内容) %>% summarise_at(.vars = 1:3,.funs = mean) %>%
separate(性別仕事内容,into = c("性別","仕事内容"),sep="_") -> coord_性別仕事内容
coord_性別仕事内容## # A tibble: 24 × 5
## 性別 仕事内容 dim.1 dim.2 dim.3
## <chr> <chr> <dbl> <dbl> <dbl>
## 1 その他 その他 -0.509 -0.470 -0.442
## 2 その他 サービス職 -0.0437 -0.0808 -0.0527
## 3 その他 事務職 -0.177 -0.179 0.0455
## 4 その他 専門職・技術職 -0.191 -0.0722 0.133
## 5 その他 無回答 -0.230 -0.0347 -0.161
## 6 その他 販売職 -0.245 -0.124 0.0649
## 7 女性 その他 -0.0894 -0.0213 -0.0421
## 8 女性 サービス職 -0.132 0.00792 -0.0133
## 9 女性 事務職 0.0151 -0.0687 0.00669
## 10 女性 専門職・技術職 0.119 -0.130 -0.0123
## # ℹ 14 more rowspi12.grey +
geom_point(data = coord_性別仕事内容 %>% filter(性別=="男性"),aes(x=dim.1,y=dim.2),col="blue") +
# geom_text_repel(data = coord_性別仕事内容 %>% filter(性別=="男性"),aes(x=dim.1,y=dim.2,label=仕事内容)) +
geom_point(data = coord_性別仕事内容 %>% filter(性別=="女性"),aes(x=dim.1,y=dim.2),col="red") #+ 
# geom_text_repel(data = coord_性別仕事内容 %>% filter(性別=="女性"),aes(x=dim.1,y=dim.2,label=仕事内容)) pi12.grey +
geom_point(data = coord_性別仕事内容 %>% filter(性別!="その他"),aes(x=dim.1,y=dim.2,colour=性別)) +
geom_text_repel(data = coord_性別仕事内容 %>% filter(性別!="その他"),aes(x=dim.1,y=dim.2,label=仕事内容,colour=性別)) +
xlim(c(-0.5, 0.5)) + ylim(c(-0.5,0.5))## Warning: Removed 622 rows containing missing values (`geom_point()`).
coord_性別仕事内容 %>% filter(性別!="その他") %>%
ggplot(aes(x=dim.1,y=dim.2,colour=性別)) +
geom_point(data = coord_性別仕事内容 %>% filter(性別!="その他"),aes(x=dim.1,y=dim.2,colour=性別)) +
geom_text_repel(data = coord_性別仕事内容 %>% filter(性別!="その他"),aes(x=dim.1,y=dim.2,label=仕事内容,colour=性別)) +
geom_vline(xintercept = 0,colour="grey") + geom_hline(yintercept = 0,colour="grey")+
ggtitle("性別-仕事内容の個体マップ上のplot")