package
library(tidyverse)
## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr 1.1.2 ✔ readr 2.1.4
## ✔ forcats 1.0.0 ✔ stringr 1.5.0
## ✔ ggplot2 3.4.2 ✔ tibble 3.2.1
## ✔ lubridate 1.9.2 ✔ tidyr 1.3.0
## ✔ purrr 1.0.1
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag() masks stats::lag()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors
library(GDAtools)
library(explor)
library(ggrepel)
library(showtext)
## 要求されたパッケージ sysfonts をロード中です
## 要求されたパッケージ showtextdb をロード中です
showtext_auto(TRUE)
データlaod（嗜好データ日本語版）
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
多重対応分析
res.speMCA0 <- speMCA(.d_J[1:1215,3:6])
res.speMCA0 %>% flip.mca(dim=c(1,2)) -> res.speMCA
個体雲を描画
ggcloud_indiv(res.speMCA,col="grey") -> pi12
ggcloud_indiv(res.speMCA,col="grey",axes = c(2,3)) -> pi23
個体雲マップに表示する番号とその座標を取得
id <- c(1,7,31,140,235,350,679,1215) # 表示する個体番号
res.speMCA$ind$coord[id,1:2] -> id_points12
res.speMCA$ind$coord[id,2:3] -> id_points23
as.character(id) # map に表示するラベル
## [1] "1" "7" "31" "140" "235" "350" "679" "1215"
1−2マップにオーバーレイ
#id_points %>% as_data_frame %>% mutate(id=id %>% factor) -> id.p.df
#pi12 + geom_point(data=id.p.df,aes(x=dim.1,y=dim.2)) +
# annotate("text",x=id.p.df[,1],y=id.p.df[,2],label="X")
# geom_text_repel(aes(label=id))
pi12 + geom_point(data = as_data_frame(id_points12), aes(x=dim.1,y=dim.2),size=4,shape="★") + annotate("text",x=id_points12[,1],y=id_points12[,2]+0.08,label=str_c("#",as.character(id))) +
coord_fixed(ratio = 1) +
ggtitle("図1−2")
## Warning: `as_data_frame()` was deprecated in tibble 2.0.0.
## ℹ Please use `as_tibble()` (with slightly different semantics) to convert to a
## tibble, or `as.data.frame()` to convert to a data frame.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.
2−3マップにオーバーレイ
pi23 + geom_point(data = as_data_frame(id_points23), aes(x=dim.2,y=dim.3),size=4,shape="★") + annotate("text",x=id_points23[,1],y=id_points23[,2]+0.08,label=str_c("#",as.character(id))) +
coord_fixed(ratio = 1) +
ggtitle("図2−3")
