library(tidyverse)
library(readxl)
library(vcdExtra)
library(gt)
library(FactoMineR)
library(showtext)
showtext_auto(TRUE)
library(explor)

1 概要

本稿は、SSJDA(Nesstar)でリモート集計されたクロス表から「個票」の形式を復元する方法のその２、多元表を複数変数の「個票」に復元する方法について記述する。

クロス表を個票に復元する手順は以下のようになる。

集計されたクロス表をなんらかの方法で、度数表（Freq form）に変換する。その度数表を、vcdExtra::expand.dft() を用いて各行をそのFreqに示されている数だけ復元する。こうして、個票（case form）は復元される。

その１では、２元クロス表を個票（case form）に変換（復元）する方法について確認し、記述した。その際に、クロス表を度数表に変換する方法を確認したが、本稿（その２）では、その方法を用いて、多元クロス表を複数変数の「個票」に変換する。

2 行名、列名ベクトルの生成

.text <- "年齢    そう思う    どちらかといえばそう思う    どちらかといえばそう思わない  そう思わない  DKNA"
stringr::str_split(.text,pattern = "\t") %>% unlist()　->cnames

"年齢 そう思う    どちら_そう思う    どちら_そう思わない  そう思わない  DKNA" %>% stringr::str_split(pattern = "\t") %>% unlist() -> cnames2

.text2 <- "20代,30代,40代,50代,60代" 
stringr::str_split(.text2,pattern = ",") %>% unlist()　->rnames
.dtext <- "20,63,77,151,14,28,131,126,204,27,27,147,158,212,18,50,166,165,279,24,121,220,151,211,37"
stringr::str_split(.dtext,pattern = ",") %>% unlist()　->.ddd
matrix(as.numeric(.ddd),5,5,byrow=TRUE) -> .d
colnames(.d) <- cnames[-1]
rownames(.d) <- rnames
#.d %>% gt()
.d %>% knitr::kable()
.d -> .d0

3 多元表として集計された表形式のデータから複数列の個票への変換

4 row（年齢、性別、Q16a）、col（Q16c）を展開する

リモート集計によるクロス表

リモート集計による、性別、年齢、Q16a、Q16cの多重クロス表

.dname <- read_excel("SSM2005-Q16multi.xls",skip=3,n_max = 1)
## New names:
## • `` -> `...2`
## • `` -> `...3`
names(.dname) %>% .[4:8] -> lnames
.dm <- read_excel("SSM2005-Q16multi.xls",skip=4)
## New names:
## • `` -> `...4`
## • `` -> `...5`
## • `` -> `...6`
## • `` -> `...7`
## • `` -> `...8`
## • `` -> `...9`
names(.dm)[4:8] <- names(.dname) %>% .[4:8]
.dm %>% rename(性別="問1(1)性 別",Q16a=names(.dm)[2],年齢=names(.dm)[3]) %>% fill("性別") %>% fill(Q16a) %>% select(-"...9") %>% filter(性別!="N=") %>% 
pivot_longer(names_to = "Q16c",values_to = "Freq",cols=-c(年齢,性別,Q16a)) %>% expand.dft() %>% 
  mutate(Q16af=factor(Q16a,levels=lnames),Q16cf=factor(Q16c,levels=lnames)) %>% select(性別,年齢,Q16af,Q16cf)-> .tblq16
.tblq16 %>% summary()
##      性別                年齢                                Q16af     
##  Length:2827        Min.   :20.00   そう思う                    : 246  
##  Class :character   1st Qu.:37.00   どちらかといえばそう思う    : 727  
##  Mode  :character   Median :50.00   どちらかといえばそう思わない: 677  
##                     Mean   :48.17   そう思わない                :1057  
##                     3rd Qu.:60.00   DKNA                        : 120  
##                     Max.   :70.00                                      
##                           Q16cf     
##  そう思う                    : 572  
##  どちらかといえばそう思う    :1141  
##  どちらかといえばそう思わない: 418  
##  そう思わない                : 545  
##  DKNA                        : 151  
## 
.tblq16 %>% count(Q16af,Q16cf) %>% pivot_wider(names_from = Q16cf,values_from = n) %>% knitr::kable()
Q16af そう思う どちらかといえばそう思う どちらかといえばそう思わない そう思わない DKNA
そう思う 172 44 8 17 5
どちらかといえばそう思う 180 441 64 31 11
どちらかといえばそう思わない 79 316 199 66 17
そう思わない 132 319 139 427 40
DKNA 9 21 8 4 78

5 男女別にクロス表をつくってクラメールのVを計算する。

.tblq16 %>% filter(性別=="男性") %>% count(Q16af,Q16cf) %>% pivot_wider(names_from = "Q16cf",values_from = "n") %>% write_excel_csv("male.csv")
  
#knitr::kable(caption = "男性")


.tblq16 %>% filter(性別=="女性") %>% count(Q16af,Q16cf) %>% pivot_wider(names_from = "Q16cf",values_from = "n") %>% write_excel_csv("female.csv")
  
#knitr::kable(caption = "女性")

6 MCA を行う

.tblq16 %>% mutate(年齢f= factor(年齢)) %>% select(-年齢) %>% filter(Q16af!="DKNA") %>% filter(Q16cf!="DKNA") -> .tblq16f
res.MCA <- MCA(.tblq16f,quali.sup = c(1,4))

#explor(res.MCA)

これでは年齢がごちゃごちゃでわからないので、年齢を10歳刻みに変換。そして、年齢10歳刻み＋性別のinteractive coding を行う。

.tblq16 %>% mutate(Age10=as.integer(as.numeric(`年齢`)/10)*10) %>% mutate(Age10性別= str_c("A",Age10,性別)) %>% 
  select(-年齢,-Age10) %>% filter(Q16af!="DKNA") %>% filter(Q16cf!="DKNA") -> .tblq16Age10
res.MCA2 <- MCA(.tblq16Age10,quali.sup = c(1,4))
## Warning: ggrepel: 9 unlabeled data points (too many overlaps). Consider
## increasing max.overlaps

#explor(res.MCA2)