20201029 ZEMI DRAFT
library(tidyverse) # tidyverse## -- Attaching packages -------- tidyverse 1.3.0 --## v ggplot2 3.3.2 v purrr 0.3.4
## v tibble 3.0.3 v dplyr 1.0.2
## v tidyr 1.1.2 v stringr 1.4.0
## v readr 1.3.1 v forcats 0.5.0## -- Conflicts ----------- tidyverse_conflicts() --
## x dplyr::filter() masks stats::filter()
## x dplyr::lag() masks stats::lag()library(ggpubr) # Publication Ready Plots
library(rstatix) # Pipe-Friendly Framework for Basic Statistical Tests##
## Attaching package: 'rstatix'## The following object is masked from 'package:stats':
##
## filterlibrary(readxl)
library(psych)##
## Attaching package: 'psych'## The following objects are masked from 'package:ggplot2':
##
## %+%, alphaset.seed(123)lisasdata <- read_excel("C:/Users/oldri/Dropbox/zemizemi/lisas/lisas2.xlsx", sheet = "mat_mh")
lisasdata <- lisasdata[-1]1 20201029
Gower距離・K-mediodsで２つのクラスタ(M・Hの質問)に分けました。 データ：MATのMとHの質問紙から
library(cluster)
lisas.gower <- daisy(lisasdata, metric = "gower", stand = FALSE)
library(factoextra)## Welcome! Want to learn more? See two factoextra-related books at https://goo.gl/ve3WBafviz_nbclust(lisasdata, pam, method = "silhouette")+
theme_classic()
pam.gower.res <- pam(lisas.gower, 2, diss = TRUE)
print(pam.gower.res)## Medoids:
## ID
## [1,] 22 22
## [2,] 4 4
## Clustering vector:
## [1] 1 2 2 2 1 1 2 1 2 2 1 1 2 2 2 2 2 1 2 2 1 1 1 1 2 1 1 1 1 2 1 2 2 2 2 2
## Objective function:
## build swap
## 0.1452877 0.1452877
##
## Available components:
## [1] "medoids" "id.med" "clustering" "objective" "isolation"
## [6] "clusinfo" "silinfo" "diss" "call"head(pam.gower.res$clustering)## [1] 1 2 2 2 1 1dd <- cbind(lisasdata, cluster = pam.gower.res$cluster)
dd$cluster <- as.factor(dd$cluster)
summary(dd$cluster)## 1 2
## 16 202 クラスタリング M・Hのデータに基づいて
2.1 クラスタリングの結果
2.1.1 Q1 cluster 1
dd.q1 <- dd %>% select(1,4,9)
dd.q2 <- dd %>% select(2,5,9)
dd.q3 <- dd %>% select(3,6,9)
dd.q4 <- dd %>% select(7,8,9)
dd.q1.c1 <- dd.q1 %>% filter(cluster == "1")
dd.q1.c2 <- dd.q1 %>% filter(cluster == "2")
dd.q2.c1 <- dd.q2 %>% filter(cluster == "1")
dd.q2.c2 <- dd.q2 %>% filter(cluster == "2")
dd.q3.c1 <- dd.q3 %>% filter(cluster == "1")
dd.q3.c2 <- dd.q3 %>% filter(cluster == "2")
dd.q4.c1 <- dd.q4 %>% filter(cluster == "1")
dd.q4.c2 <- dd.q4 %>% filter(cluster == "2")
dd.q1.c1.long <- dd.q1.c1 %>%
gather(key = "load", value = "score", Q1M, Q1H)
bxp <- ggpaired(dd.q1.c1.long, x = "load", y = "score",
order = c("Q1M", "Q1H"),
ylab = "Score", xlab = "load")
bxp
dd.q1.c1 <- dd.q1.c1 %>% mutate(differences = Q1H - Q1M)
gghistogram(dd.q1.c1, x = "differences", y = "..density..",
fill = "steelblue",bins = 5, add_density = TRUE)
stat.test <- dd.q1.c1.long %>%
wilcox_test(score ~ load, paired = TRUE) %>%
add_significance()
stat.testdd.q1.c1.long %>%
wilcox_effsize(score ~ load, paired = TRUE)stat.test <- stat.test %>% add_xy_position(x = "group")
bxp +
stat_pvalue_manual(stat.test, tip.length = 0) +
labs(subtitle = get_test_label(stat.test, detailed= TRUE))
### Q1 cluster 2
dd.q1.c2.long <- dd.q1.c2 %>%
gather(key = "load", value = "score", Q1M, Q1H)
bxp <- ggpaired(dd.q1.c2.long, x = "load", y = "score",
order = c("Q1M", "Q1H"),
ylab = "Score", xlab = "load")
bxp
dd.q1.c2 <- dd.q1.c2 %>% mutate(differences = Q1H - Q1M)
gghistogram(dd.q1.c2, x = "differences", y = "..density..",
fill = "steelblue",bins = 5, add_density = TRUE)
stat.test <- dd.q1.c2.long %>%
wilcox_test(score ~ load, paired = TRUE) %>%
add_significance()
stat.testdd.q1.c2.long %>%
wilcox_effsize(score ~ load, paired = TRUE)stat.test <- stat.test %>% add_xy_position(x = "group")
bxp +
stat_pvalue_manual(stat.test, tip.length = 0) +
labs(subtitle = get_test_label(stat.test, detailed= TRUE))
2.1.2 Q2 cluster 1
dd.q2.c1.long <- dd.q2.c1 %>%
gather(key = "load", value = "score", Q2M, Q2H)
bxp <- ggpaired(dd.q2.c1.long, x = "load", y = "score",
order = c("Q2M", "Q2H"),
ylab = "Score", xlab = "load")
bxp
dd.q2.c1 <- dd.q2.c1 %>% mutate(differences = Q2H - Q2M)
gghistogram(dd.q2.c1, x = "differences", y = "..density..",
fill = "steelblue",bins = 5, add_density = TRUE)
stat.test <- dd.q2.c1.long %>%
wilcox_test(score ~ load, paired = TRUE) %>%
add_significance()
stat.testdd.q2.c1.long %>%
wilcox_effsize(score ~ load, paired = TRUE)stat.test <- stat.test %>% add_xy_position(x = "group")
bxp +
stat_pvalue_manual(stat.test, tip.length = 0) +
labs(subtitle = get_test_label(stat.test, detailed= TRUE))
2.1.3 Q2 cluster 2
dd.q2.c2.long <- dd.q2.c2 %>%
gather(key = "load", value = "score", Q2M, Q2H)
bxp <- ggpaired(dd.q2.c2.long, x = "load", y = "score",
order = c("Q2M", "Q2H"),
ylab = "Score", xlab = "load")
bxp
dd.q2.c2 <- dd.q2.c2 %>% mutate(differences = Q2H - Q2M)
gghistogram(dd.q2.c2, x = "differences", y = "..density..",
fill = "steelblue",bins = 5, add_density = TRUE)
stat.test <- dd.q2.c2.long %>%
wilcox_test(score ~ load, paired = TRUE) %>%
add_significance()
stat.testdd.q2.c2.long %>%
wilcox_effsize(score ~ load, paired = TRUE)stat.test <- stat.test %>% add_xy_position(x = "group")
bxp +
stat_pvalue_manual(stat.test, tip.length = 0) +
labs(subtitle = get_test_label(stat.test, detailed= TRUE))
2.1.4 Q3 cluster 1
dd.q3.c1.long <- dd.q3.c1 %>%
gather(key = "load", value = "score", Q3M, Q3H)
bxp <- ggpaired(dd.q3.c1.long, x = "load", y = "score",
order = c("Q3M", "Q3H"),
ylab = "Score", xlab = "load")
bxp
dd.q3.c1 <- dd.q3.c1 %>% mutate(differences = Q3H - Q3M)
gghistogram(dd.q3.c1, x = "differences", y = "..density..",
fill = "steelblue",bins = 5, add_density = TRUE)
stat.test <- dd.q3.c1.long %>%
wilcox_test(score ~ load, paired = TRUE) %>%
add_significance()
stat.testdd.q3.c1.long %>%
wilcox_effsize(score ~ load, paired = TRUE)stat.test <- stat.test %>% add_xy_position(x = "group")
bxp +
stat_pvalue_manual(stat.test, tip.length = 0) +
labs(subtitle = get_test_label(stat.test, detailed= TRUE))
2.1.5 Q3 cluster 2
dd.q3.c2.long <- dd.q3.c2 %>%
gather(key = "load", value = "score", Q3M, Q3H)
bxp <- ggpaired(dd.q3.c2.long, x = "load", y = "score",
order = c("Q3M", "Q3H"),
ylab = "Score", xlab = "load")
bxp
dd.q3.c2 <- dd.q3.c2 %>% mutate(differences = Q3H - Q3M)
gghistogram(dd.q3.c2, x = "differences", y = "..density..",
fill = "steelblue",bins = 5, add_density = TRUE)
stat.test <- dd.q3.c2.long %>%
wilcox_test(score ~ load, paired = TRUE) %>%
add_significance()
stat.testdd.q3.c2.long %>%
wilcox_effsize(score ~ load, paired = TRUE)stat.test <- stat.test %>% add_xy_position(x = "group")
bxp +
stat_pvalue_manual(stat.test, tip.length = 0) +
labs(subtitle = get_test_label(stat.test, detailed= TRUE))
2.1.6 Q4 cluster 1
dd.q4.c1.long <- dd.q4.c1 %>%
gather(key = "load", value = "score", Q4M, Q4H)
bxp <- ggpaired(dd.q4.c1.long, x = "load", y = "score",
order = c("Q4M", "Q4H"),
ylab = "Score", xlab = "load")
bxp
dd.q4.c1 <- dd.q4.c1 %>% mutate(differences = Q4H - Q4M)
gghistogram(dd.q4.c1, x = "differences", y = "..density..",
fill = "steelblue",bins = 5, add_density = TRUE)
stat.test <- dd.q4.c1.long %>%
wilcox_test(score ~ load, paired = TRUE) %>%
add_significance()
stat.testdd.q4.c1.long %>%
wilcox_effsize(score ~ load, paired = TRUE)stat.test <- stat.test %>% add_xy_position(x = "group")
bxp +
stat_pvalue_manual(stat.test, tip.length = 0) +
labs(subtitle = get_test_label(stat.test, detailed= TRUE))
2.1.7 Q4 cluster 2
dd.q4.c2.long <- dd.q4.c2 %>%
gather(key = "load", value = "score", Q4M, Q4H)
bxp <- ggpaired(dd.q4.c2.long, x = "load", y = "score",
order = c("Q4M", "Q4H"),
ylab = "Score", xlab = "load")
bxp
dd.q4.c2 <- dd.q4.c2 %>% mutate(differences = Q4H - Q4M)
gghistogram(dd.q4.c2, x = "differences", y = "..density..",
fill = "steelblue",bins = 5, add_density = TRUE)
stat.test <- dd.q4.c2.long %>%
wilcox_test(score ~ load, paired = TRUE) %>%
add_significance()
stat.testdd.q4.c2.long %>%
wilcox_effsize(score ~ load, paired = TRUE)stat.test <- stat.test %>% add_xy_position(x = "group")
bxp +
stat_pvalue_manual(stat.test, tip.length = 0) +
labs(subtitle = get_test_label(stat.test, detailed= TRUE))
## LISASの結果
lisasdata.mat.rt <- read_excel("C:/Users/oldri/Dropbox/zemizemi/lisas/lisas2.xlsx", sheet = "mat")
lisasdata.mat.rt <- lisasdata.mat.rt %>% select(id,COMPLEXITY,lisas,cluster)
lisasdata.mat.rt.c1 <- lisasdata.mat.rt %>% filter(cluster == "1")
lisasdata.mat.rt.c2 <- lisasdata.mat.rt %>% filter(cluster == "2")
lisasdata.sat.rt <- read_excel("C:/Users/oldri/Dropbox/zemizemi/lisas/lisas2.xlsx", sheet = "sat")
lisasdata.sat.rt <- lisasdata.sat.rt %>% select(id,COMPLEXITY,lisas,cluster)
lisasdata.sat.rt.c1 <- lisasdata.sat.rt %>% filter(cluster == "1")
lisasdata.sat.rt.c2 <- lisasdata.sat.rt %>% filter(cluster == "2")2.2 Cluster 1 LISAS MAT
bxp <- ggpaired(lisasdata.mat.rt.c1, x = "COMPLEXITY", y = "lisas",
order = c("M", "H"),
ylab = "LISAS", xlab = "COMPLEXITY")
#bxp
stat.test <- lisasdata.mat.rt.c1 %>%
t_test(lisas ~ COMPLEXITY, paired = TRUE) %>%
add_significance()
stat.testlisasdata.mat.rt.c1 %>% cohens_d(lisas ~ COMPLEXITY, paired = TRUE)stat.test <- stat.test %>% add_xy_position(x = "COMPLEXITY")
bxp +
stat_pvalue_manual(stat.test, tip.length = 0) +
labs(subtitle = get_test_label(stat.test, detailed= TRUE))+
ggtitle("LISAS MAT Cluster 1")
## Cluster 2 LISAS MAT
bxp <- ggpaired(lisasdata.mat.rt.c2, x = "COMPLEXITY", y = "lisas",
order = c("M", "H"),
ylab = "LISAS", xlab = "COMPLEXITY")
stat.test <- lisasdata.mat.rt.c2 %>%
t_test(lisas ~ COMPLEXITY, paired = TRUE) %>%
add_significance()
stat.testlisasdata.mat.rt.c2 %>% cohens_d(lisas ~ COMPLEXITY, paired = TRUE)stat.test <- stat.test %>% add_xy_position(x = "COMPLEXITY")
bxp +
stat_pvalue_manual(stat.test, tip.length = 0) +
labs(subtitle = get_test_label(stat.test, detailed= TRUE))+
ggtitle("LISAS MAT Cluster 2")
2.3 Cluster 1 LISAS SAT
bxp <- ggpaired(lisasdata.sat.rt.c1, x = "COMPLEXITY", y = "lisas",
order = c("M", "H"),
ylab = "LISAS", xlab = "COMPLEXITY")
stat.test <- lisasdata.sat.rt.c1 %>%
t_test(lisas ~ COMPLEXITY, paired = TRUE) %>%
add_significance()
stat.testlisasdata.sat.rt.c1 %>% cohens_d(lisas ~ COMPLEXITY, paired = TRUE)stat.test <- stat.test %>% add_xy_position(x = "COMPLEXITY")
bxp +
stat_pvalue_manual(stat.test, tip.length = 0) +
labs(subtitle = get_test_label(stat.test, detailed= TRUE))+
ggtitle("LISAS SAT Cluster 1")
2.4 Cluster 2 LISAS SAT
bxp <- ggpaired(lisasdata.sat.rt.c2, x = "COMPLEXITY", y = "lisas",
order = c("M", "H"),
ylab = "LISAS", xlab = "COMPLEXITY")
stat.test <- lisasdata.sat.rt.c2 %>%
t_test(lisas ~ COMPLEXITY, paired = TRUE) %>%
add_significance()
stat.testlisasdata.sat.rt.c2 %>% cohens_d(lisas ~ COMPLEXITY, paired = TRUE)stat.test <- stat.test %>% add_xy_position(x = "COMPLEXITY")
bxp +
stat_pvalue_manual(stat.test, tip.length = 0) +
labs(subtitle = get_test_label(stat.test, detailed= TRUE)) +
ggtitle("LISAS SAT Cluster 2")
3 クラスタリング L・M・Hのデータに基づいて
lisasdata.lmh <- read_excel("C:/Users/oldri/Dropbox/zemizemi/lisas/lisas2.xlsx", sheet = "mat_lmh")
lisasdata.lmh <- lisasdata.lmh[-1]
library(cluster)
lisas.lmh.gower <- daisy(lisasdata.lmh, metric = "gower", stand = FALSE)
library(factoextra)
fviz_nbclust(lisasdata.lmh, pam, method = "silhouette")+
theme_classic()
pam.gower.lmh.res <- pam(lisas.lmh.gower, 2, diss = TRUE)
print(pam.gower.lmh.res)## Medoids:
## ID
## [1,] 28 28
## [2,] 33 33
## Clustering vector:
## [1] 1 2 2 2 1 2 2 2 2 2 1 2 1 2 2 2 2 2 2 2 2 2 2 2 2 1 2 1 2 2 1 2 2 2 2 2
## Objective function:
## build swap
## 0.1658069 0.1658069
##
## Available components:
## [1] "medoids" "id.med" "clustering" "objective" "isolation"
## [6] "clusinfo" "silinfo" "diss" "call"head(pam.gower.lmh.res$clustering)## [1] 1 2 2 2 1 2dd.lmh <- cbind(lisasdata.lmh, cluster = pam.gower.lmh.res$cluster)
dd.lmh$cluster <- as.factor(dd.lmh$cluster)
summary(dd.lmh$cluster)## 1 2
## 7 29dd <- dd.lmhlisasdata.mat.rt <- read_excel("C:/Users/oldri/Dropbox/zemizemi/lisas/lisas2.xlsx", sheet = "mat")
lisasdata.mat.rt <- lisasdata.mat.rt %>% select(id,COMPLEXITY,lisas)
lmh.cluster <- rep(dd$cluster,2)
lisasdata.mat.rt <- cbind(lisasdata.mat.rt, cluster = lmh.cluster)
lisasdata.mat.rt.c1 <- lisasdata.mat.rt %>% filter(cluster == "1")
lisasdata.mat.rt.c2 <- lisasdata.mat.rt %>% filter(cluster == "2")
lisasdata.sat.rt <- read_excel("C:/Users/oldri/Dropbox/zemizemi/lisas/lisas2.xlsx", sheet = "sat")
lisasdata.sat.rt <- lisasdata.sat.rt %>% select(id,COMPLEXITY,lisas)
lisasdata.sat.rt <- cbind(lisasdata.sat.rt, cluster = lmh.cluster)
lisasdata.sat.rt.c1 <- lisasdata.sat.rt %>% filter(cluster == "1")
lisasdata.sat.rt.c2 <- lisasdata.sat.rt %>% filter(cluster == "2")3.1 Cluster 1 LISAS MAT
bxp <- ggpaired(lisasdata.mat.rt.c1, x = "COMPLEXITY", y = "lisas",
order = c("M", "H"),
ylab = "LISAS", xlab = "COMPLEXITY")
#bxp
stat.test <- lisasdata.mat.rt.c1 %>%
t_test(lisas ~ COMPLEXITY, paired = TRUE) %>%
add_significance()
stat.testlisasdata.mat.rt.c1 %>% cohens_d(lisas ~ COMPLEXITY, paired = TRUE)stat.test <- stat.test %>% add_xy_position(x = "COMPLEXITY")
bxp +
stat_pvalue_manual(stat.test, tip.length = 0) +
labs(subtitle = get_test_label(stat.test, detailed= TRUE))+
ggtitle("LISAS MAT Cluster 1")
3.2 Cluster 2 LISAS MAT
bxp <- ggpaired(lisasdata.mat.rt.c2, x = "COMPLEXITY", y = "lisas",
order = c("M", "H"),
ylab = "LISAS", xlab = "COMPLEXITY")
stat.test <- lisasdata.mat.rt.c2 %>%
t_test(lisas ~ COMPLEXITY, paired = TRUE) %>%
add_significance()
stat.testlisasdata.mat.rt.c2 %>% cohens_d(lisas ~ COMPLEXITY, paired = TRUE)stat.test <- stat.test %>% add_xy_position(x = "COMPLEXITY")
bxp +
stat_pvalue_manual(stat.test, tip.length = 0) +
labs(subtitle = get_test_label(stat.test, detailed= TRUE))+
ggtitle("LISAS MAT Cluster 2")
3.3 Cluster 1 LISAS SAT
bxp <- ggpaired(lisasdata.sat.rt.c1, x = "COMPLEXITY", y = "lisas",
order = c("M", "H"),
ylab = "LISAS", xlab = "COMPLEXITY")
stat.test <- lisasdata.sat.rt.c1 %>%
t_test(lisas ~ COMPLEXITY, paired = TRUE) %>%
add_significance()
stat.testlisasdata.sat.rt.c1 %>% cohens_d(lisas ~ COMPLEXITY, paired = TRUE)stat.test <- stat.test %>% add_xy_position(x = "COMPLEXITY")
bxp +
stat_pvalue_manual(stat.test, tip.length = 0) +
labs(subtitle = get_test_label(stat.test, detailed= TRUE))+
ggtitle("LISAS SAT Cluster 1")
3.4 Cluster 2 LISAS SAT
bxp <- ggpaired(lisasdata.sat.rt.c2, x = "COMPLEXITY", y = "lisas",
order = c("M", "H"),
ylab = "LISAS", xlab = "COMPLEXITY")
stat.test <- lisasdata.sat.rt.c2 %>%
t_test(lisas ~ COMPLEXITY, paired = TRUE) %>%
add_significance()
stat.testlisasdata.sat.rt.c2 %>% cohens_d(lisas ~ COMPLEXITY, paired = TRUE)stat.test <- stat.test %>% add_xy_position(x = "COMPLEXITY")
bxp +
stat_pvalue_manual(stat.test, tip.length = 0) +
labs(subtitle = get_test_label(stat.test, detailed= TRUE)) +
ggtitle("LISAS SAT Cluster 2")
4 まとめ
4.1 MH
MATのMHの質問からクラスタリングした結果、クラスタ１が16名、クラスタ2が20名。 クラスタ1は認知負荷の上昇につれて、面白さが変わらないタイプの人である。クラスタ1は認知負荷の上昇につれて、面白さが上昇するタイプの人である。
クラスタ1のMATタスクのLISASは、MとHの間の差は有意であったが、クラスタ2では有意ではなかった。 SATのLISASは両タイプとも有意であったが…
4.2 LMH
MATのLMHの質問からクラスタリングした結果、クラスタ1が7名で、クラスタ2が29名。
クラスタ2のMATタスクのLISASは、MとHの間の差は有意であったが、クラスタ1では有意ではなかった。 SATのLISASは両タイプとも有意であったが…
LMHでのクラスタ2は基本MHでのクラスタ1である。