library(tidyverse)
library(GDAtools)
library(showtext)
showtext_auto(TRUE)
load("taste_d_J.rda")
.d_J
## # A tibble: 1,253 × 9
## ID Isup TV Film Art Eat Gender Age Income
## <int> <fct> <fct> <fct> <fct> <fct> <fct> <fct> <fct>
## 1 1 Active TV-メロドラマ 映画-アクション 芸術… 外食… 女性 55-64 £20-29
## 2 2 Active TV-メロドラマ 映画-ホラー 芸術… 外食… 女性 45-54 <£9
## 3 3 Active TV-自然 映画-アクション 芸術… 外食… 女性 55-64 <£9
## 4 4 Active TV-メロドラマ 映画-時代劇 芸術… 外食… 女性 65+ £10-19
## 5 5 Active TV-コメディー 映画-ホラー 芸術… 外食… 女性 35-44 £10-19
## 6 6 Active TV-コメディー 映画-ホラー 芸術… 外食… 女性 18-24 <£9
## 7 7 Active TV-ニュース 映画-アクション 芸術… 外食… 女性 25-34 £10-19
## 8 8 Active TV-ニュース 映画-ドキュメンタ… 芸術… 外食… 男性 65+ £10-19
## 9 9 Active TV-メロドラマ 映画-時代劇 芸術… 外食… 女性 65+ <£9
## 10 10 Active TV-ニュース 映画-アクション 芸術… 外食… 女性 65+ £10-19
## # ℹ 1,243 more rows
Isup == “Active” の1215行を切り出す
.d_J %>% filter(Isup=="Active") -> .d0
MCAを実行
res.speMCA0 <- speMCA(.d0[,3:6])
res.speMCA0 %>% flip.mca(dim = c(1,2)) -> res.speMCA
追加要素を接続する
res.speMCA$ind$coord[,1:3] -> coord_ind
cbind(coord_ind[,1:3],.d0[,7:9]) -> ind_coord_sup
個体空間と変数空間
ggcloud_indiv(resmca = res.speMCA,axes = c(1,2),col = "grey") -> pi12
ggcloud_indiv(resmca = res.speMCA,axes = c(3,2),col = "grey") -> pi32
ggcloud_variables(resmca = res.speMCA,axes = c(1,2)) -> pv12
ggcloud_variables(resmca = res.speMCA,axes = c(3,2)) -> pv32
#pi12
#pi32
#pv12
#pv32
典型性検定
性別Gender
ggadd_kellipses(p=pi12,axes = c(1,2), resmca = res.speMCA,var = .d0$Gender,label.size = 5,points = FALSE) + coord_fixed(ratio = 1) + ggtitle("1-2軸 性別")
ggadd_kellipses(p=pi32,axes = c(3,2), resmca = res.speMCA,var = .d0$Gender,label.size = 5,points = FALSE) + coord_fixed(ratio = 1) + ggtitle("3-2軸 性別")
varsup(resmca = res.speMCA,var = .d0$Gender)$var[,1:3]
## Warning in varsup(resmca = res.speMCA, var = .d0$Gender): varsup function is
## softly deprecated. Please use supvar function instead
## dim.1 dim.2 dim.3
## 男性 0.291503 0.252755 0.256650
## 女性 0.463911 0.391608 0.261315
## within 0.391117 0.332981 0.259345
## between 0.009239 0.018185 0.065664
## total 0.400355 0.351166 0.325009
## eta2 0.023076 0.051784 0.202037
dimtypicality(resmca = res.speMCA,vars = .d0[,7] ,dim = c(1,2,3))
## $dim.1
## weight test.stat p.value
## Gender.女性 702 5.292893 0
## Gender.男性 513 -5.292893 0
##
## $dim.2
## weight test.stat p.value
## Gender.女性 702 7.928809 0
## Gender.男性 513 -7.928809 0
##
## $dim.3
## weight test.stat p.value
## Gender.男性 513 15.66118 0
## Gender.女性 702 -15.66118 0
年齢 Age
ggadd_kellipses(p=pi12,axes = c(1,2), resmca = res.speMCA,var = .d0$Age,label.size = 5) + coord_fixed(ratio = 1)
ggadd_kellipses(p=pi32,axes = c(3,2), resmca = res.speMCA,var = .d0$Age,label.size = 5) + coord_fixed(ratio = 1)
varsup(resmca = res.speMCA,var = .d0$Age)
## Warning in varsup(resmca = res.speMCA, var = .d0$Age): varsup function is
## softly deprecated. Please use supvar function instead
## $weight
## 18-24 25-34 35-44 45-54 55-64 65+
## 93 248 258 191 183 242
##
## $coord
## dim.1 dim.2 dim.3 dim.4 dim.5
## 18-24 0.931381 -0.560840 0.025403 0.115942 0.004309
## 25-34 0.430211 -0.321909 -0.025081 -0.096911 0.117306
## 35-44 0.140690 -0.089947 0.091602 -0.001088 0.162993
## 45-54 -0.085003 -0.117601 -0.081577 -0.078554 0.003276
## 55-64 -0.579679 0.170546 -0.022807 0.036059 -0.097176
## 65+ -0.443355 0.605165 -0.000086 0.090649 -0.224741
##
## $cos2
## dim.1 dim.2 dim.3 dim.4 dim.5
## 18-24 0.071903 0.026072 0.000053 0.001114 0.000002
## 25-34 0.047467 0.026576 0.000161 0.002409 0.003529
## 35-44 0.005336 0.002181 0.002262 0.000000 0.007162
## 45-54 0.001348 0.002580 0.001241 0.001151 0.000002
## 55-64 0.059586 0.005158 0.000092 0.000231 0.001675
## 65+ 0.048888 0.091086 0.000000 0.002044 0.012562
##
## $var
## dim.1 dim.2 dim.3 dim.4 dim.5
## 18-24 0.191606 0.394644 0.258083 0.314694 0.325950
## 25-34 0.308269 0.322495 0.293415 0.378507 0.318695
## 35-44 0.337113 0.288032 0.340576 0.336486 0.325177
## 45-54 0.360430 0.317632 0.312032 0.357470 0.278026
## 55-64 0.312070 0.245902 0.409496 0.223183 0.272795
## 65+ 0.340083 0.314282 0.307831 0.219342 0.246341
## within 0.320573 0.306763 0.324007 0.306296 0.292909
## between 0.079782 0.044403 0.001002 0.001771 0.005958
## total 0.400355 0.351166 0.325009 0.308067 0.298867
## eta2 0.199278 0.126444 0.003084 0.005749 0.019936
##
## $typic
## dim.1 dim.2 dim.3 dim.4 dim.5
## 18-24 9.342901 -5.625920 0.254824 1.163038 0.043229
## 25-34 7.591076 -5.680095 -0.442562 -1.709991 2.069858
## 35-44 2.545227 -1.627232 1.657182 -0.019689 2.948705
## 45-54 -1.279119 -1.769648 -1.227564 -1.182067 0.049298
## 55-64 -8.505159 2.502285 -0.334629 0.529068 -1.425782
## 65+ -7.703930 10.515601 -0.001495 1.575150 -3.905189
##
## $pval
## dim.1 dim.2 dim.3 dim.4 dim.5
## 18-24 0.000000 0.000000 0.798859 0.244814 0.965519
## 25-34 0.000000 0.000000 0.658083 0.087268 0.038466
## 35-44 0.010921 0.103688 0.097483 0.984292 0.003191
## 45-54 0.200855 0.076786 0.219611 0.237179 0.960682
## 55-64 0.000000 0.012339 0.737905 0.596758 0.153931
## 65+ 0.000000 0.000000 0.998807 0.115222 0.000094
##
## $cor
## dim.1 dim.2 dim.3 dim.4 dim.5
## 18-24 0.268 -0.161 0.007 0.033 0.001
## 25-34 0.218 -0.163 -0.013 -0.049 0.059
## 35-44 0.073 -0.047 0.048 -0.001 0.085
## 45-54 -0.037 -0.051 -0.035 -0.034 0.001
## 55-64 -0.244 0.072 -0.010 0.015 -0.041
## 65+ -0.221 0.302 0.000 0.045 -0.112
dimtypicality(resmca = res.speMCA,vars = .d0[,8] ,dim = c(1,2,3))
## $dim.1
## weight test.stat p.value
## Age.18-24 93 9.342901 0.00000
## Age.25-34 248 7.591076 0.00000
## Age.35-44 258 2.545227 0.01092
## Age.45-54 191 -1.279119 0.20086
## Age.65+ 242 -7.703930 0.00000
## Age.55-64 183 -8.505159 0.00000
##
## $dim.2
## weight test.stat p.value
## Age.65+ 242 10.515601 0.00000
## Age.55-64 183 2.502285 0.01234
## Age.35-44 258 -1.627232 0.10369
## Age.45-54 191 -1.769648 0.07679
## Age.18-24 93 -5.625920 0.00000
## Age.25-34 248 -5.680095 0.00000
##
## $dim.3
## weight test.stat p.value
## Age.35-44 258 1.657182 0.09748
## Age.18-24 93 0.254824 0.79886
## Age.65+ 242 -0.001495 0.99881
## Age.55-64 183 -0.334629 0.73790
## Age.25-34 248 -0.442562 0.65808
## Age.45-54 191 -1.227564 0.21961