infer 파이프라인 이어서

R로 하는 가설 검정

Richie Cotton

Data Evangelist at DataCamp

복습: 가설과 데이터셋

$H_{0}$: 30세 미만 취미 개발자의 비율은 30세 이상의 비율과 같다.

$H_{A}$: 30세 미만 취미 개발자의 비율은 30세 이상의 비율과 다르다.

alpha <- 0.1

stack_overflow_imbalanced %>% 
  count(hobbyist, age_cat, .drop = FALSE)

  hobbyist     age_cat    n
1       No At least 30    0
2       No    Under 30  191
3      Yes At least 30   15
4      Yes    Under 30 1025

복습: 워크플로

null_distn <- dataset %>% 
  specify() %>% 
  hypothesize() %>% 
  generate() %>% 
  calculate()

observed_stat <- dataset %>% 
  specify() %>% 
  calculate()

get_p_value(null_distn, observed_stat)

stack_overflow_imbalanced %>%
  specify(hobbyist ~ age_cat, success = "Yes") %>% 
  hypothesize(null = "independence")

Response: hobbyist (factor)
Explanatory: age_cat (factor)
Null Hypothesis: independence
# A tibble: 1,231 x 2
  hobbyist age_cat    
  <fct>    <fct>      
1 Yes      At least 30
2 Yes      At least 30
3 Yes      At least 30
4 Yes      Under 30   
5 Yes      At least 30
6 Yes      At least 30
7 No       Under 30   
# ... with 1,224 more rows

generate() 도입 배경

$H_{0}$: 30세 미만 취미 개발자의 비율은 30세 이상의 비율과 같다.

$H_{0}$이 참이라면,

각 행에서 취미 여부 값은 어느 연령 범주와도 동일한 확률로 나타날 수 있습니다.
이를 시뮬레이션하기 위해 연령 범주를 고정한 채 취미 여부 값을 순열(셔플)할 수 있습니다.

stack_overflow_imbalanced

# A tibble: 1,231 x 2
  hobbyist age_cat    
  <fct>    <fct>      
1 Yes      At least 30
2 Yes      At least 30
3 Yes      At least 30
4 Yes      Under 30   
5 Yes      At least 30
6 Yes      At least 30
7 No       Under 30   
# ... with 1,224 more rows

bind_cols(
  stack_overflow_imbalanced %>% 
    select(hobbyist) %>% 
    slice_sample(prop = 1),
  stack_overflow_imbalanced %>% 
    select(age_cat)
)

# A tibble: 1,231 x 2
  hobbyist age_cat    
  <fct>    <fct>      
1 Yes      At least 30
2 Yes      At least 30
3 No       At least 30
4 No       Under 30   
5 Yes      At least 30
6 Yes      At least 30
7 Yes      Under 30   
# ... with 1,224 more rows

복제본 다수 생성

왼쪽에는 열 지정 결과인 두 열 직사각형 그리드가 표시됩니다. 오른쪽에 generate라는 단어와 화살표가 있으며, 그 오른쪽에 세 개의 두 열 그리드(복제본)가 있습니다. 각 복제본의 오른쪽 열은 원본과 동일하여 설명 변수가 변경되지 않음을 나타냅니다. 왼쪽 열은 다르며, 반응 변수가 순열됨을 나타냅니다.

generate()

generate()는 귀무 가설을 반영한 시뮬레이션 데이터를 생성합니다.

"independence" 귀무 가설에는 type을 "permute"로 설정합니다.
"point" 귀무 가설에는 type을 "bootstrap" 또는 "simulate"로 설정합니다.

stack_overflow_imbalanced %>%
  specify(hobbyist ~ age_cat, success = "Yes") %>% 
  hypothesize(null = "independence") %>% 
  generate(reps = 5000, type = "permute")

Response: hobbyist (factor)
Explanatory: age_cat (factor)
Null Hypothesis: independence
# A tibble: 6,155,000 x 3
# Groups:   replicate [5,000]
  hobbyist age_cat     replicate
  <fct>    <fct>           <int>
1 Yes      At least 30         1
2 Yes      At least 30         1
3 Yes      At least 30         1
4 Yes      Under 30            1
5 Yes      At least 30         1
6 Yes      At least 30         1
7 Yes      Under 30            1
# ... with 6,154,993 more rows

검정 통계량 계산

원본 데이터셋과 복제본을 나타내는 직사각형 그리드가 표시됩니다. 그 아래에 'calculate'라는 단어와 각 복제본 아래의 아래쪽 화살표가 있습니다. 각 화살표 아래에는 검정 통계량을 나타내는 셀이 있습니다. 복제본의 모든 검정 통계량에 상자가 그려져 있으며 '귀무 분포'라고 표시되어 있습니다.

calculate()

calculate()는 귀무 분포라고 하는 검정 통계량의 분포를 계산합니다.

null_distn <- stack_overflow_imbalanced %>%
  specify(
    hobbyist ~ age_cat, 
    success = "Yes"
  ) %>%
  hypothesize(null = "independence") %>%
  generate(reps = 5000, type = "permute") %>%
  calculate(
    stat = "diff in props", 
    order = c("At least 30", "Under 30")
  )

# A tibble: 5,000 x 2
  replicate    stat
      <int>   <dbl>
1         1  0.0896
2         2  0.0896
3         3 -0.180 
4         4  0.157 
5         5  0.0896
6         6 -0.113 
7         7  0.0221
# ... with 4,993 more rows

¹ ?calculate 도움말 페이지에서 가능한 모든 검정 통계량을 확인할 수 있습니다.

귀무 분포 시각화

visualize(null_distn)

귀무 분포의 히스토그램. 왼쪽으로 치우쳐 있으며 9개의 고유 값이 있습니다.

null_distn %>% count(stat)

# A tibble: 9 x 2
     stat     n
    <dbl> <int>
1 -0.383      2
2 -0.315     22
3 -0.248     63
4 -0.180    246
5 -0.113    641
6 -0.0454  1132
7  0.0221  1453
8  0.0896  1063
9  0.157    378

원본 데이터셋의 검정 통계량 계산

원본 데이터셋과 복제본을 나타내는 직사각형 그리드, 그리고 calculate 단계에서 본 귀무 분포 셀이 표시됩니다. 이번에는 원본 데이터셋 아래에 아래쪽 화살표와 셀이 추가되어 있으며, 이 셀에 '관측 통계량'이라는 상자가 표시됩니다.

관측 통계량: specify() %>% calculate()

obs_stat <- stack_overflow_imbalanced %>%
  specify(hobbyist ~ age_cat, success = "Yes") %>%
  # hypothesize(null = "independence") %>%
  # generate(reps = 5000, type = "permute") %>%
  calculate(
    stat = "diff in props",
    order = c("At least 30", "Under 30")
  )

# A tibble: 1 x 1
   stat
  <dbl>
1 0.157

귀무 분포와 관측 통계량 시각화

visualize(null_distn) +
  geom_vline(
    aes(xintercept = stat),
    data = observed_stat, 
    color = "red"
  )

귀무 분포의 히스토그램에 관측 통계량 위치에 빨간 수직선이 추가되어 있습니다. 수직선은 히스토그램의 가장 오른쪽 막대 위에 있습니다.

p-값 구하기

get_p_value(
  null_distn, obs_stat, 
  direction = "two sided"   # Not alternative = "two.sided"
)

# A tibble: 1 x 1
  p_value
    <dbl>
1   0.151

# A tibble: 1 x 6
  statistic chisq_df p_value alternative lower_ci upper_ci
      <dbl>    <dbl>   <dbl> <chr>          <dbl>    <dbl>
1      2.79        1  0.0949 two.sided    0.00718   0.0217

연습해 봅시다!

R로 하는 가설 검정