Section 01. 적합도 검정
> # 자유도가 3인 χ2-분포에서 기각역(α=0.05)
>
> x <- seq(0, 15, by=0.01)
> dc <- dchisq(x, df=3)
>
> alpha <- 0.05
> tol <- qchisq(0.95, df=3)
>
> par(mar=c(0,1,1,1))
> plot(x, dc, type="l", axes=F, ylim=c(-0.03, 0.25), xlab="", ylab="", col = "blue")
> abline(h=0)
> abline(h=0, col = "blue")
> tol.g <- round(tol, 2)
> polygon(c(tol.g, x[x>tol.g], 15), c(0, dc[x>tol.g], 0), col="red")
> text(0, -0.03, "0", cex=0.8)
> text(tol, -0.03, expression(chi[0.05]^{2}==2.14), cex=0.8)

>
> # 적합도 검정 : chisq.test()를 이용한 검정
>
> # 멘델의 유전법칙에 의하면
> # 완두콩의 형질은 둥글고 황색, 둥글고 녹색, 주름지고 황색, 주름지고 녹색이 9:3:3:1의 비율로 나타난다고 한다.
> # 멘델은 556개의 완두콩을 관찰하였으며, 그 결과 둥글고 황색인 콩 315개, 둥글고 녹색인 콩 101개, 주름지고 황색인 콩 108개, 주름지고 녹색인 콩 32개로 나타났음을 그의 논문에서 밝혔다.
> # 그가 이야기한 9:3:3:1의 비율이 맞게 나타난 것인지 통계적 가설검정을 통해 확인해 보고자 한다.
>
> x <- c(315, 101, 108, 32)
> chisq.test(x, p=c(9, 3, 3, 1)/16)
Chi-squared test for given probabilities
data: x
X-squared = 0.47002, df = 3, p-value = 0.9254
> # 유의확률이 0.9254로 유의수준 0.05보다 크므로 대립가설을 기각한다.
> # 즉 완두콩의 형질은 멘델의 유전법칙을 잘 따른다고 할 수 있다.
>
Section 02. 동질성 검정과 독립성 검정
> ## 02) 연령대별 SNS 이용률의 동질성 검정
>
> sns.c <- read.csv("./data/snsbyage.csv", header=T, stringsAsFactors=FALSE)
> str( sns.c )
'data.frame': 1439 obs. of 2 variables:
$ age : int 1 1 1 1 1 1 1 1 1 1 ...
$ service: chr "F" "F" "F" "F" ...
>
> sns.c <- transform(sns.c, age.c =
+ factor(age, levels=c(1, 2, 3),
+ labels=c("20대", "30대", "40대")))
> sns.c <- transform(sns.c, service.c =
+ factor(service, levels=c("F", "T", "K", "C", "E"),
+ ordered=TRUE))
> str( sns.c )
'data.frame': 1439 obs. of 4 variables:
$ age : int 1 1 1 1 1 1 1 1 1 1 ...
$ service : chr "F" "F" "F" "F" ...
$ age.c : Factor w/ 3 levels "20대","30대",..: 1 1 1 1 1 1 1 1 1 1 ...
$ service.c: Ord.factor w/ 5 levels "F"<"T"<"K"<"C"<..: 1 1 1 1 1 1 1 1 1 1 ...
>
> # 기대도수 구하기
>
> # 분할표 생성
> c.tab <- table(sns.c$age.c, sns.c$service.c)
> # 연령대별 사용자 수
> (a.n <- margin.table(c.tab, margin = 1))
20대 30대 40대
532 571 336
> # 서비스별 이용자 수의 비율
> (s.n <- margin.table(c.tab, margin = 2))
F T K C E
392 297 480 222 48
> (s.p <- s.n / margin.table(c.tab))
F T K C E
0.2724114 0.2063933 0.3335650 0.1542738 0.0333565
> # 기대도수
> expected <- a.n %*% t(s.p)
> round(expected, 2)
F T K C E
20대 144.92 109.80 177.46 82.07 17.75
30대 155.55 117.85 190.47 88.09 19.05
40대 91.53 69.35 112.08 51.84 11.21
>
> # 검정통계량 구하기
>
> # 관찰도수 table - 기대도수 table
> (o.e <- c.tab - expected)
F T K C E
20대 62.077137 7.198749 -66.456567 -1.073662 -1.745657
30대 -48.546908 -13.850591 45.534399 20.909659 -4.046560
40대 -13.530229 6.651842 20.922168 -19.835997 5.792217
> # 검정통계량
> (t.t <- sum( o.e^2 / expected))
[1] 102.752
>
> # 유의수준 0.05에서의 기각역과 검정통계량으로부터 구한 유의확률
> # 자유도 = (행의 개수 - 1) * (열의 개수 - 1) = (3-1) * (5-1) = 8
> qchisq(0.95, df=8)
[1] 15.50731
> 1-pchisq(t.t, df=8)
[1] 0
>
> # chisq.test() 함수 이용
> chisq.test(c.tab)
Pearson's Chi-squared test
data: c.tab
X-squared = 102.75, df = 8, p-value < 2.2e-16
> # 유의확률이 0에 가까워 유의수준 0.05보다 작으므로 대립가설을 채택한다.
> # 즉 연령대별로 SNS 서비스별 이용현황이 다르다고 할 수 있다.
>
> ## 03) 성별에 따른 대학원 입학 여부의 독립성 검정
>
> data(UCBAdmissions)
> UCBAdmissions
, , Dept = A
Gender
Admit Male Female
Admitted 512 89
Rejected 313 19
, , Dept = B
Gender
Admit Male Female
Admitted 353 17
Rejected 207 8
...
, , Dept = F
Gender
Admit Male Female
Admitted 22 24
Rejected 351 317
> ucba.tab <- apply(UCBAdmissions, c(1, 2), sum)
> # 성별 합격 여부에 대한 자료
> ucba.tab
Gender
Admit Male Female
Admitted 1198 557
Rejected 1493 1278
> round(prop.table(ucba.tab, margin=2) * 100, 1)
Gender
Admit Male Female
Admitted 44.5 30.4
Rejected 55.5 69.6
>
> # 기대도수 구하기
>
> # 합격 여부별 합
> (a.n <- margin.table(ucba.tab, margin = 1))
Admit
Admitted Rejected
1755 2771
> # 성별 합
> (g.n <- margin.table(ucba.tab, margin = 2))
Gender
Male Female
2691 1835
>
> # 합격 여부별 비율
> (a.p <- a.n / margin.table(ucba.tab))
Admit
Admitted Rejected
0.3877596 0.6122404
> # 성별 비율
> (g.p <- g.n / margin.table(ucba.tab))
Gender
Male Female
0.5945647 0.4054353
>
> # 기대도수 = 전체 지원자 수 * 합격 여부 비율 * 성별 비율
> expected <- margin.table(ucba.tab) * (a.p %*% t(g.p))
> round(expected, 2)
Gender
Admit Male Female
Admitted 1043.46 711.54
Rejected 1647.54 1123.46
>
> # 검정통계량 구하기
>
> # 관찰도수 table - 기대도수 table
> (o.e <- ucba.tab - expected)
Gender
Admit Male Female
Admitted 154.5389 -154.5389
Rejected -154.5389 154.5389
> # 검정통계량
> (t.t <- sum( o.e^2 / expected))
[1] 92.20528
>
> # 유의수준 0.05에서의 기각역과 검정통계량으로부터 구한 유의확률
> # 자유도 = (행의 개수 - 1) * (열의 개수 - 1) = (2-1) * (2-1) = 1
> qchisq(0.95, df=1)
[1] 3.841459
> 1-pchisq(t.t, df=1)
[1] 0
>
> # chisq.test() 함수 이용
> chisq.test(ucba.tab)
Pearson's Chi-squared test with Yates' continuity correction
data: ucba.tab
X-squared = 91.61, df = 1, p-value < 2.2e-16
> # chisq.test()는 2X2 분할표에 대해서는 '연속성 수정'을 통해 카이제곱 통계량을 구하는 것이 기본으로 되어 있다.
> # 2X2 자료에서 각 항이 나타나는 확률이 이항분포를 따르지만, 여러 번 반복할 경우 이항분포가 정규분포와 비슷한 형태를 가지게 되어 정규분포로 가정하고, 이산형 분포를 연속형 분포로 가정 시 발생하는 차이를 수정하기 위해 다음과 같이 'Yates의 연속성 수정'을 사용한다.
> # 연속성 수정을 통합 검정통계량 구하기
> o.e2 <- (abs(ucba.tab - expected)-0.5)^2 / expected
> sum(o.e2)
[1] 91.6096
> # 연속성 수정을 하지 않고자 할 경우
> chisq.test(ucba.tab, correct = F)
Pearson's Chi-squared test
data: ucba.tab
X-squared = 92.205, df = 1, p-value < 2.2e-16
출처 : 이윤환, ⌜제대로 알고 쓰는 R 통계분석⌟, 한빛아카데미, 2020
'데이터분석 > R' 카테고리의 다른 글
[R 통계분석] 상관과 회귀 (0) | 2022.08.27 |
---|---|
[R 통계분석] 여러 모집단의 평균 비교 검정 (0) | 2022.08.15 |
[R 통계분석] 가설검정 (0) | 2022.08.12 |
[R 통계분석] 추정 (0) | 2022.08.11 |
[R 통계분석] 표본분포 (0) | 2022.08.10 |