6.3. Test proporcija

Test proporcija je jedan od najčešće korišćenih testova u statističkom testiranju hipoteza. Ovo prosto iz razloga što dosta obilježja ima formu proporcije (učešće određene vrijednosti u ukupnoj populaciji). Test proporcija može biti test na osnovu jednog ili dva uzorka, isto kao i t-test. Test statistika na osnovu jednog uzorka računa se po sljedećoj formuli:

$$Z_1 = \frac{\hat{p} - p_0}{\sqrt{\frac{p_0(1-p_0)}{n}}}$$

gdje $\hat{p}$ predstavlja proporciju na osnovu uzorka, $p_0$ test proporciju, dok $n$ predstavlja broj testiranih podataka.

Test statistika testa proporcije na osnovu dva uzorka računa se kao:

$$Z_2 = \frac{\hat{p_1} - \hat{p_2}}{\sqrt{\frac{\hat{p_1}n_1 + \hat{p_2}n_2}{n_1+n_2}(1 - \frac{\hat{p_1}n_1 + \hat{p_2}n_2}{n_1+n_2})(\frac{1}{n_1} + \frac{1}{n_2})}}$$

Pretpostavka za obje test statistike ( $Z_1, Z_2$ ) jeste da mogu biti aproksimirane standardnim normalnim rasporedom (aritmetička sredina 0 i standardna devijacija 1), pa se na osnovu tog rasporeda i utvrđuju teorijske vrijednosti testa i vjerovatnoća.

Test proporcija naročito je primjenljiv u validaciji PD modela u kojoj se obično testira da li je ostvareni PD manji od modeliranog PD-ija ili je jednak sa njima, kao i za testiranje heterogenosti PD rejting skale.

Primjer 43: Simulirati 1000 vrijednosti iz binomne distribucije, sa vjerovatnoćom uspjeha od 5%. Vrijednosti jednake jedinici predstavljaju simulirane loše kredite (default), dok vrijednosti jedake nule predstavljaju dobre kredite (non-default). Koristeći test proporcije i za nivo značajnosti od 5%, testirati da li je stopa defaulta iz uzorka:

1. različita od 5%;

2. manja od 6%;

3. veća od 5%.

> set.seed(1990)
> pd <- 0.05
> n <- 1e3
> alpha <- 0.05
> default <- rbinom(n = n, size = 1, prob = pd)
> dr <- sum(default == 1) / length(default)
> dr
[1] 0.051
> #1. H1: dr razlicit od 5%
> t.stat.1 <- (dr - 0.05) / sqrt((0.05 * (1 - 0.05) / n))
> p.val1 <- 2 * pnorm(-abs(t.stat.1), lower.tail = TRUE)
> p.val1
[1] 0.8846357
> p.val1 < alpha
[1] FALSE
> prop.t.1 <- prop.test(x = sum(default == 1), n = n, p = 0.05, alternative = "two.sided", correct = FALSE)
> prop.t.1

        1-sample proportions test without continuity correction

data:  sum(default == 1) out of n, null probability 0.05
X-squared = 0.021053, df = 1, p-value = 0.8846
alternative hypothesis: true p is not equal to 0.05
95 percent confidence interval:
 0.03900094 0.06643549
sample estimates:
    p 
0.051 

> prop.t.1$p.val
[1] 0.8846357
> #2. H1: dr manji od 6%
> t.stat.2 <- (dr - 0.06) / sqrt((0.06 * (1 - 0.06) / n))
> p.val2 <- pnorm(t.stat.2, lower.tail = TRUE)
> p.val2
[1] 0.11538
> p.val2 < alpha
[1] FALSE
> prop.t.2 <- prop.test(x = sum(default == 1), n = n, p = 0.06, alternative = "less", correct = FALSE)
> prop.t.2

        1-sample proportions test without continuity correction

data:  sum(default == 1) out of n, null probability 0.06
X-squared = 1.4362, df = 1, p-value = 0.1154
alternative hypothesis: true p is less than 0.06
95 percent confidence interval:
 0.00000000 0.06370325
sample estimates:
    p 
0.051 

> prop.t.2$p.val
[1] 0.11538
> #3. H1: dr veci od 5%
> t.stat.3 <- (dr - 0.05) / sqrt((0.05 * (1 - 0.05) / n))
> p.val3 <- pnorm(t.stat.3, lower.tail = FALSE)
> p.val3
[1] 0.4423178
> p.val3 < alpha
[1] FALSE
> prop.t.3 <- prop.test(x = sum(default == 1), n = n, p = 0.05, alternative = "greater", correct = FALSE)
> prop.t.3

        1-sample proportions test without continuity correction

data:  sum(default == 1) out of n, null probability 0.05
X-squared = 0.021053, df = 1, p-value = 0.4423
alternative hypothesis: true p is greater than 0.05
95 percent confidence interval:
 0.04071977 1.00000000
sample estimates:
    p 
0.051 

> prop.t.3$p.val
[1] 0.4423178

Primjer 44: Simulirati ostvarene stope defaultaa za dvije rejting klase iz binomnog rasporeda i to sa sljedećim karakteristikama:

a) rejting klasa 1 (rc1) – 500 klijenata i vjerovatnoća defaulta 2.5%; b) rejting klasa 2 (rc2) – 350 klijenata i vjerovatnoća defaulta 4%.

Testirati hipotezu da je stopa defaulta rejting klase 2 veća od stope defaulta rejting klase 1.

> set.seed(321)
> #H1: stopa default-a rc2 veca od stope default-a rc1
> alpha <- 0.05
> n1 <- 500
> pd1 <- 0.025
> n2 <- 350
> pd2 <- 0.04
> rc1 <- rbinom(n = n1, size = 1, prob = pd1)
> rc2 <- rbinom(n = n2, size = 1, prob = pd2)
> dr.rc1 <- sum(rc1) / n1
> dr.rc1
[1] 0.028
> dr.rc2 <- sum(rc2) / n2
> dr.rc2
[1] 0.04571429
> #zajednicka proporcija (pooled proportion)
> pp <- (dr.rc1 * n1 + dr.rc2 * n2) / (n1 + n2)
> pp
[1] 0.03529412
> #zajednicka standardna greska (pooled standard error)
> se <- sqrt(pp * (1 - pp) * ((1 / n1) + (1 / n2))) 
> se
[1] 0.01285994
> #test statistika
> test.stat <- (dr.rc2 - dr.rc1) / se
> test.stat
[1] 1.377478
> #p vrijednosti
> p.val <- pnorm(test.stat, lower.tail = FALSE)
> p.val
[1] 0.0841823
> p.val < alpha
[1] FALSE
> #r funkcija prop.test
> prop.t <- prop.test(x = c(sum(rc2), sum(rc1)), n = c(n2, n1), alternative = "greater", correct = FALSE)
> prop.t

        2-sample test for equality of proportions without continuity correction

data:  c(sum(rc2), sum(rc1)) out of c(n2, n1)
X-squared = 1.8974, df = 1, p-value = 0.08418
alternative hypothesis: greater
95 percent confidence interval:
 -0.004296867  1.000000000
sample estimates:
    prop 1     prop 2 
0.04571429 0.02800000 

> prop.t$p.val
[1] 0.0841823