본문 바로가기
데이터분석/R

[R 통계분석] 범주형 자료분석

by 버섯도리 2022. 8. 19.

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