Data Mining Theory And Reality09
데이터마이닝의 이론과 실제 9주차
반복측정 분산분석 (Repeated Measures ANOVA)
시점이 여러개 일때 사용
library(tidyverse)
## -- Attaching packages --------------------------------------- tidyverse 1.3.1 --
## v ggplot2 3.3.5 v purrr 0.3.4
## v tibble 3.1.6 v dplyr 1.0.8
## v tidyr 1.2.0 v stringr 1.4.0
## v readr 2.1.2 v forcats 0.5.1
## -- Conflicts ------------------------------------------ tidyverse_conflicts() --
## x dplyr::filter() masks stats::filter()
## x dplyr::lag() masks stats::lag()
library(tidymodels)
## -- Attaching packages -------------------------------------- tidymodels 0.2.0 --
## v broom 0.8.0 v rsample 0.1.1
## v dials 0.1.1 v tune 0.2.0
## v infer 1.0.0 v workflows 0.2.6
## v modeldata 0.1.1 v workflowsets 0.2.1
## v parsnip 0.2.1 v yardstick 0.0.9
## v recipes 0.2.0
## -- Conflicts ----------------------------------------- tidymodels_conflicts() --
## x scales::discard() masks purrr::discard()
## x dplyr::filter() masks stats::filter()
## x recipes::fixed() masks stringr::fixed()
## x dplyr::lag() masks stats::lag()
## x yardstick::spec() masks readr::spec()
## x recipes::step() masks stats::step()
## * Use suppressPackageStartupMessages() to eliminate package startup messages
library(rstatix)
##
## 다음의 패키지를 부착합니다: 'rstatix'
## The following objects are masked from 'package:infer':
##
## chisq_test, prop_test, t_test
## The following object is masked from 'package:dials':
##
## get_n
## The following object is masked from 'package:stats':
##
## filter
library(skimr)
#데이터 가져오기
rma_tb <- read_csv("09.RMA.csv",
col_names = TRUE,
na =".",
locale = locale("ko", encoding = "euc-kr")) %>%
mutate_if(is.character, as.factor)%>%
mutate(시점 = factor(시점,
levels = c(1:3),
labels = c("사전","3개월후","6개월후")))
## Rows: 135 Columns: 3
## -- Column specification --------------------------------------------------------
## Delimiter: ","
## dbl (3): id, 시점, 점수
##
## i Use `spec()` to retrieve the full column specification for this data.
## i Specify the column types or set `show_col_types = FALSE` to quiet this message.
str(rma_tb)
## tibble [135 x 3] (S3: tbl_df/tbl/data.frame)
## $ id : num [1:135] 1 1 1 2 2 2 3 3 3 4 ...
## $ 시점: Factor w/ 3 levels "사전","3개월후",..: 1 2 3 1 2 3 1 2 3 1 ...
## $ 점수: num [1:135] 63 64 68 60 61 67 61 67 70 57 ...
rma_tb
## # A tibble: 135 x 3
## id 시점 점수
## <dbl> <fct> <dbl>
## 1 1 사전 63
## 2 1 3개월후 64
## 3 1 6개월후 68
## 4 2 사전 60
## 5 2 3개월후 61
## 6 2 6개월후 67
## 7 3 사전 61
## 8 3 3개월후 67
## 9 3 6개월후 70
## 10 4 사전 57
## # ... with 125 more rows
기술 통계
rma_tb %>%
group_by(시점) %>%
get_summary_stats(점수)
## # A tibble: 3 x 14
## 시점 variable n min max median q1 q3 iqr mad mean sd
## <fct> <chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 사전 점수 45 53 67 60 58 63 5 2.96 60.2 3.22
## 2 3개월후 점수 45 55 70 61 59 64 5 4.45 61.6 3.60
## 3 6개월후 점수 45 65 73 68 67 69 2 1.48 68.1 1.83
## # ... with 2 more variables: se <dbl>, ci <dbl>
그래프 그리기
rma_tb %>%
ggplot(mapping = aes(x=시점,
y=점수)) +
geom_boxplot()
rma_tb %>%
ggplot(mapping = aes(x=점수))+
geom_histogram(bins = 10) +
facet_wrap(~시점)
이상치 제거
rma_tb %>%
group_by(시점) %>%
identify_outliers(점수)
## # A tibble: 1 x 5
## 시점 id 점수 is.outlier is.extreme
## <fct> <dbl> <dbl> <lgl> <lgl>
## 1 6개월후 37 73 TRUE FALSE
정규분포 검정
rma_tb %>%
group_by(시점) %>%
shapiro_test(점수)
## # A tibble: 3 x 4
## 시점 variable statistic p
## <fct> <chr> <dbl> <dbl>
## 1 사전 점수 0.972 0.339
## 2 3개월후 점수 0.962 0.149
## 3 6개월후 점수 0.954 0.0737
구형성 (p값이 0.05보다 크면 구형성 성립,Mauchly’s Test for Sphericity)
rma_results <- rma_tb %>%
anova_test(dv = 점수,
wid = id,
within = 시점)
rma_results
## ANOVA Table (type III tests)
##
## $ANOVA
## Effect DFn DFd F p p<.05 ges
## 1 시점 2 88 248.614 6.24e-37 * 0.579
##
## $`Mauchly's Test for Sphericity`
## Effect W p p<.05
## 1 시점 0.963 0.446
##
## $`Sphericity Corrections`
## Effect GGe DF[GG] p[GG] p[GG]<.05 HFe DF[HF] p[HF]
## 1 시점 0.964 1.93, 84.88 1.04e-35 * 1.008 2.02, 88.69 6.24e-37
## p[HF]<.05
## 1 *
다중비교
rma_tb %>%
pairwise_t_test(점수~시점,
paired = TRUE,
p.adj = "bonferroni")
## # A tibble: 3 x 10
## .y. group1 group2 n1 n2 statistic df p p.adj p.adj.signif
## * <chr> <chr> <chr> <int> <int> <dbl> <dbl> <dbl> <dbl> <chr>
## 1 점수 사전 3개월~ 45 45 -3.44 44 1 e- 3 4 e- 3 **
## 2 점수 사전 6개월~ 45 45 -23.0 44 3.48e-26 1.04e-25 ****
## 3 점수 3개월~ 6개월~ 45 45 -17.0 44 6.18e-21 1.85e-20 ****
일변량분석
rma_result_ow <- aov(점수~시점 + Error(id/시점),
data= rma_tb)
summary(rma_result_ow)
##
## Error: id
## Df Sum Sq Mean Sq F value Pr(>F)
## Residuals 1 13.24 13.24
##
## Error: id:시점
## Df Sum Sq Mean Sq
## 시점 2 1136 568
##
## Error: Within
## Df Sum Sq Mean Sq F value Pr(>F)
## 시점 2 500.4 250.2 28.43 5.9e-11 ***
## Residuals 129 1135.4 8.8
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
이원 분산분석 (Two-way ANOVA)
library(tidyverse)
library(tidymodels)
library(rstatix)
library(skimr)
#데이터 가져오기
twa_tb <- read_csv("10.TWA.csv",
col_names = TRUE,
na =".",
locale = locale("ko", encoding = "euc-kr")) %>%
mutate_if(is.character, as.factor)%>%
mutate(방법 = factor(방법,
levels = c(1:2),
labels = c("오븐","기름"))) %>%
mutate(온도 = factor(온도,
levels = c(1:2),
labels = c("200도","300도")))
## Rows: 60 Columns: 3
## -- Column specification --------------------------------------------------------
## Delimiter: ","
## dbl (3): 방법, 온도, 맛점수
##
## i Use `spec()` to retrieve the full column specification for this data.
## i Specify the column types or set `show_col_types = FALSE` to quiet this message.
str(twa_tb)
## tibble [60 x 3] (S3: tbl_df/tbl/data.frame)
## $ 방법 : Factor w/ 2 levels "오븐","기름": 1 1 1 1 1 1 1 1 1 1 ...
## $ 온도 : Factor w/ 2 levels "200도","300도": 2 2 2 2 2 2 2 2 2 2 ...
## $ 맛점수: num [1:60] 95 93 94 98 97 94 96 92 91 94 ...
twa_tb
## # A tibble: 60 x 3
## 방법 온도 맛점수
## <fct> <fct> <dbl>
## 1 오븐 300도 95
## 2 오븐 300도 93
## 3 오븐 300도 94
## 4 오븐 300도 98
## 5 오븐 300도 97
## 6 오븐 300도 94
## 7 오븐 300도 96
## 8 오븐 300도 92
## 9 오븐 300도 91
## 10 오븐 300도 94
## # ... with 50 more rows
기술통계
skim(twa_tb)
Name | twa_tb |
Number of rows | 60 |
Number of columns | 3 |
_______________________ | |
Column type frequency: | |
factor | 2 |
numeric | 1 |
________________________ | |
Group variables | None |
Variable type: factor
skim_variable | n_missing | complete_rate | ordered | n_unique | top_counts |
---|---|---|---|---|---|
방법 | 0 | 1 | FALSE | 2 | 오븐: 30, 기름: 30 |
온도 | 0 | 1 | FALSE | 2 | 300: 31, 200: 29 |
Variable type: numeric
skim_variable | n_missing | complete_rate | mean | sd | p0 | p25 | p50 | p75 | p100 | hist |
---|---|---|---|---|---|---|---|---|---|---|
맛점수 | 0 | 1 | 90.53 | 4.2 | 84 | 87 | 91 | 94 | 98 | ▇▇▅▇▅ |
twa_tb %>%
group_by(방법, 온도) %>%
get_summary_stats(맛점수)
## # A tibble: 4 x 15
## 방법 온도 variable n min max median q1 q3 iqr mad mean
## <fct> <fct> <chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 오븐 200도 맛점수 14 84 91 87.5 86.2 89 2.75 2.22 87.5
## 2 오븐 300도 맛점수 16 91 98 94 92.8 95.2 2.5 2.22 94.2
## 3 기름 200도 맛점수 15 90 98 94 92.5 95.5 3 2.96 94
## 4 기름 300도 맛점수 15 84 88 86 85 87 2 1.48 86
## # ... with 3 more variables: sd <dbl>, se <dbl>, ci <dbl>
그래프 그리기
twa_tb %>%
ggplot(mapping = aes(x=방법,
y=맛점수,
color = 방법)) +
geom_boxplot() +
facet_wrap(~온도)
twa_tb %>%
ggplot(mapping = aes(x=맛점수)) +
geom_histogram(bins = 10) +
facet_wrap(~ 방법*온도)
twa_tb %>%
group_by(온도, 방법) %>%
summarise(맛점수= mean(맛점수)) %>%
ggplot(mapping = aes(x=온도,
y=맛점수,
color= 방법)) +
geom_line(mapping = aes(group=방법)) +
geom_point()
## `summarise()` has grouped output by '온도'. You can override using the
## `.groups` argument.
이상치 제거
twa_tb %>%
group_by(방법, 온도) %>%
identify_outliers(맛점수)
## [1] 방법 온도 맛점수 is.outlier is.extreme
## <0 행> <또는 row.names의 길이가 0입니다>
정규분포
twa_tb %>%
group_by(방법,온도) %>%
shapiro_test(맛점수)
## # A tibble: 4 x 5
## 방법 온도 variable statistic p
## <fct> <fct> <chr> <dbl> <dbl>
## 1 오븐 200도 맛점수 0.970 0.876
## 2 오븐 300도 맛점수 0.961 0.683
## 3 기름 200도 맛점수 0.967 0.817
## 4 기름 300도 맛점수 0.918 0.181
등분산검정
twa_tb %>%
levene_test(맛점수 ~ 방법*온도)
## # A tibble: 1 x 4
## df1 df2 statistic p
## <int> <int> <dbl> <dbl>
## 1 3 56 1.46 0.235
검증
twa_results <- aov(맛점수 ~ 방법*온도,
data = twa_tb)
tidy(twa_results)
## # A tibble: 4 x 6
## term df sumsq meansq statistic p.value
## <chr> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 방법 1 17.1 17.1 4.55 3.73e- 2
## 2 온도 1 6.77 6.77 1.81 1.84e- 1
## 3 방법:온도 1 807. 807. 215. 7.70e-21
## 4 Residuals 56 210. 3.75 NA NA
twa_results <- aov(맛점수 ~ 방법+온도,
data = twa_tb)
사후검정
twa_tb %>%
group_by(온도) %>%
pairwise_t_test(맛점수 ~ 방법,
p.adj = "bonferroni")
## # A tibble: 2 x 10
## 온도 .y. group1 group2 n1 n2 p p.signif p.adj p.adj.signif
## * <fct> <chr> <chr> <chr> <int> <int> <dbl> <chr> <dbl> <chr>
## 1 200도 맛점수 오븐 기름 14 15 1.2 e- 8 **** 1.2 e- 8 ****
## 2 300도 맛점수 오븐 기름 16 15 4.81e-14 **** 4.81e-14 ****
상호작용이 없을경우
twa_results <- aov(맛점수 ~ 방법 + 온도,
data = twa_tb)
tidy(twa_results)
## # A tibble: 3 x 6
## term df sumsq meansq statistic p.value
## <chr> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 방법 1 17.1 17.1 0.956 0.332
## 2 온도 1 6.77 6.77 0.379 0.540
## 3 Residuals 57 1017. 17.8 NA NA
twa_tb %>%
pairwise_t_test(맛점수 ~ 방법,
p.adj = "bonferroni")
## # A tibble: 1 x 9
## .y. group1 group2 n1 n2 p p.signif p.adj p.adj.signif
## * <chr> <chr> <chr> <int> <int> <dbl> <chr> <dbl> <chr>
## 1 맛점수 오븐 기름 30 30 0.33 ns 0.33 ns
이원 반복측정 분산분석 (Two way repeated measures ANOVA)
library(tidyverse)
library(tidymodels)
library(rstatix)
library(skimr)
#데이터 가져오기
twrma_tb <- read_csv("11.TWRMA.csv",
col_names = TRUE,
na =".",
locale = locale("ko", encoding = "euc-kr")) %>%
mutate_if(is.character, as.factor)%>%
mutate(실험그룹 = factor(실험그룹,
levels = c(1:2),
labels = c("대조군","실험군")))
## Rows: 127 Columns: 4
## -- Column specification --------------------------------------------------------
## Delimiter: ","
## dbl (4): id, 실험그룹, 사전, 사후
##
## i Use `spec()` to retrieve the full column specification for this data.
## i Specify the column types or set `show_col_types = FALSE` to quiet this message.
str(twrma_tb)
## tibble [127 x 4] (S3: tbl_df/tbl/data.frame)
## $ id : num [1:127] 1 2 3 4 5 6 7 8 9 10 ...
## $ 실험그룹: Factor w/ 2 levels "대조군","실험군": 1 1 1 1 1 1 1 1 1 1 ...
## $ 사전 : num [1:127] 12.3 57.2 12.3 16.6 18.6 ...
## $ 사후 : num [1:127] 23.1 40.5 23.1 45 40.8 ...
twrma_tb
## # A tibble: 127 x 4
## id 실험그룹 사전 사후
## <dbl> <fct> <dbl> <dbl>
## 1 1 대조군 12.3 23.1
## 2 2 대조군 57.2 40.4
## 3 3 대조군 12.3 23.1
## 4 4 대조군 16.6 45.0
## 5 5 대조군 18.6 40.8
## 6 6 대조군 20.1 35.1
## 7 7 대조군 20.1 35.1
## 8 8 대조군 22.8 42.1
## 9 9 대조군 22.8 42.1
## 10 10 대조군 24.4 31.1
## # ... with 117 more rows
long 형 변환
twrma_tb <- twrma_tb %>%
pivot_longer(c("사전","사후"),
names_to = "시점",
values_to = "통증")
twrma_tb
## # A tibble: 254 x 4
## id 실험그룹 시점 통증
## <dbl> <fct> <chr> <dbl>
## 1 1 대조군 사전 12.3
## 2 1 대조군 사후 23.1
## 3 2 대조군 사전 57.2
## 4 2 대조군 사후 40.4
## 5 3 대조군 사전 12.3
## 6 3 대조군 사후 23.1
## 7 4 대조군 사전 16.6
## 8 4 대조군 사후 45.0
## 9 5 대조군 사전 18.6
## 10 5 대조군 사후 40.8
## # ... with 244 more rows
기술통계
twrma_tb %>%
group_by(실험그룹, 시점) %>%
get_summary_stats(통증)
## # A tibble: 4 x 15
## 실험그룹 시점 variable n min max median q1 q3 iqr mad mean
## <fct> <chr> <chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 대조군 사전 통증 58 12.3 73.0 41.4 33.5 49.9 16.4 12.4 41.9
## 2 대조군 사후 통증 58 21.5 57.5 42.1 36.2 49.3 13.0 10.3 41.5
## 3 실험군 사전 통증 69 5.08 72.6 42.4 31.2 51.2 19.9 16.6 41.6
## 4 실험군 사후 통증 69 10.8 54.6 32.6 25.4 38.8 13.4 10.7 32.8
## # ... with 3 more variables: sd <dbl>, se <dbl>, ci <dbl>
그래프 그리기
twrma_tb %>%
ggplot(mapping = aes(x=실험그룹,
y=통증,
color = 실험그룹)) +
geom_boxplot() +
facet_wrap(~시점)
twrma_tb %>%
ggplot(mapping = aes(x=통증)) +
geom_histogram(bins = 10) +
facet_wrap(~ 실험그룹*시점)
twrma_tb %>%
group_by(시점, 실험그룹) %>%
summarise(통증= mean(통증)) %>%
ggplot(mapping = aes(x=시점,
y=통증,
color= 시점)) +
geom_line(mapping = aes(group=실험그룹)) +
geom_point()
## `summarise()` has grouped output by '시점'. You can override using the
## `.groups` argument.
이상치 제거
twrma_tb %>%
group_by(실험그룹, 시점) %>%
identify_outliers(통증)
## [1] 실험그룹 시점 id 통증 is.outlier is.extreme
## <0 행> <또는 row.names의 길이가 0입니다>
# 정규분포 검정 (3개가 정규분포 만족하므로 정규분포로 설정 )
twrma_tb %>%
group_by(실험그룹, 시점) %>%
shapiro_test(통증)
## # A tibble: 4 x 5
## 실험그룹 시점 variable statistic p
## <fct> <chr> <chr> <dbl> <dbl>
## 1 대조군 사전 통증 0.977 0.340
## 2 대조군 사후 통증 0.956 0.0351
## 3 실험군 사전 통증 0.983 0.457
## 4 실험군 사후 통증 0.983 0.487
분석
twrma_tb %>%
anova_test(dv = 통증,
wid = id,
within = 시점, # 시점이 두개 이므로 구현성 가정 안함
between = 실험그룹)
## Warning: The 'wid' column contains duplicate ids across between-subjects
## variables. Automatic unique id will be created
## ANOVA Table (type III tests)
##
## Effect DFn DFd F p p<.05 ges
## 1 실험그룹 1 125 4.666 3.30e-02 * 0.029
## 2 시점 1 125 20.902 1.15e-05 * 0.032
## 3 실험그룹:시점 1 125 17.011 6.73e-05 * 0.026
사후 검정
twrma_tb %>%
group_by(시점) %>%
pairwise_t_test(통증 ~ 실험그룹,
p.adj ="bonferroni")
## # A tibble: 2 x 10
## 시점 .y. group1 group2 n1 n2 p p.signif p.adj p.adj.signif
## * <chr> <chr> <chr> <chr> <int> <int> <dbl> <chr> <dbl> <chr>
## 1 사전 통증 대조군 실험군 58 69 0.921 ns 9.21e-1 ns
## 2 사후 통증 대조군 실험군 58 69 0.00000226 **** 2.26e-6 ****
twrma_tb %>%
group_by(실험그룹) %>%
pairwise_t_test(통증~ 시점,
paired = TRUE,
p.adj = "bonferroni")
## # A tibble: 2 x 11
## 실험그룹 .y. group1 group2 n1 n2 statistic df p p.adj
## * <fct> <chr> <chr> <chr> <int> <int> <dbl> <dbl> <dbl> <dbl>
## 1 대조군 통증 사전 사후 58 58 0.243 57 8.09e- 1 8.09e- 1
## 2 실험군 통증 사전 사후 69 69 8.85 68 6.33e-13 6.33e-13
## # ... with 1 more variable: p.adj.signif <chr>
Leave a comment