6.7. Kruskal-Wallisov test

Pandan parametarskoj ANOVA, u slučaju da nije ispunjenja pretpostavka normalnosti, jeste neparametarski Kruskal-Wallis test. Cilj korišćenja ovog testa isti je kao i u slučaju korišćenja ANOVA. pri čemu, umjesto jednakosti aritmetičkih sredina koje potiču iz više od dva uzorka, testiraju se prosječne vrijednosti rangova tih uzoraka. Test statistika ovog testa data je sljedećim izrazom:

H=12N(N+1)i=1Kri2ni3(N+1)1t(ft3ft)N3NH = \frac{\frac{12}{N(N+1)}\sum_{i=1}^{K}\frac{r_i^2}{n_i} - 3(N+1)}{1 - \frac{\sum_{t}(f_t^3-f_t)}{N^3-N}}

gdje NN predstavlja ukupan broj opservacija analiziranog obilježja, nin_i broj opservacija svakog uzorka, ri2r_i^2kvadrat sume rangova unutar ii-tog uzorka, dok je ftf_t broj ponavljanja rangova računatih u odnosu na sve vrijednosti obilježja.

Primjer 51: U fajlu LGD.csv dati su podaci o realizovanim vrijednostima LGD-ija (kolona LGDR), kao i LGD segment (kolona segment.e) kome određeni kredit pripada. Pod pretpostavkom da nisu uspunjeni uslovi normalnost, za nivo značajnosti od 5% ispitati da li postoji bar jedan par prosječnih rangova vrijednosti LGD-ija datih segmenata koji je statistički različit jedan od drugog.

> #import LGD.csv fajla
> db <- read.csv("LGD.csv", header = TRUE)
> #nivo znacajnosti
> alpha <- 0.05
> #broj uzoraka
> k <- length(unique(db$segment.e))
> k
[1] 4
> #broj opservacija
> n <- length(db$LGDR)
> n
[1] 500
> #rang
> r <- rank(db$LGDR)
> #test statistika
> ties <- table(r)
> H <- sum(tapply(r, db$segment.e, sum)^2 / tapply(r, db$segment.e, length))
> H <- ((12 * H / (n * (n + 1)) - 3 * (n + 1)) / (1 - sum(ties^3 - ties) / (n^3 - n)))
> H
[1] 417.6127
> #p vrijednost
> p.val <- pchisq(H, k - 1, lower.tail = FALSE)
> p.val
[1] 3.387807e-90
> p.val < alpha
[1] TRUE
> #r funkcija
> kw.r <- kruskal.test(db$LGDR, db$segment.e)
> kw.r

        Kruskal-Wallis rank sum test

data:  db$LGDR and db$segment.e
Kruskal-Wallis chi-squared = 417.61, df = 3, p-value < 2.2e-16

> kw.r$p.val
[1] 3.387807e-90

U slučaju da Krusal-Wallisov test pokaže da postoji makar jedan par prosječnih rangova koji su statistički značajno različiti, dalje ispitivanje tih parova može se nastaviti. Naime, kao i kod ANOVA, može se primijeniti neparametarski test iz dva uzorka i to svih mogućih parova, a zatim se mogu korigovati dobijene p vrijednosti zbog višestrukog poređenja i kontrolisanja statističke greške tipa I.

Primjer 52: Na osnovu podataka iz Primjera 45, i za isti nivo značajnosti, ispitati kod kojih parova segmenata prosječnih rangova LGD-ija postoji statistički značajna razlika. Za korekciju izračunatih p vrijednosti pojedinačnih Wilcoxonovih testova, primijentiti Bonferroni metodu.

> #uzorci za koje se racunaju parovi prosjecnih vrijednosti
> ug <- sort(unique(db$segment.e))
> ug
[1] "segment1" "segment2" "segment3" "segment4"
> #svi parovi prosjecnih vrijednosti i ukupan broj kombinacija
> tc <- combn(length(ug), 2)
> tc
     [,1] [,2] [,3] [,4] [,5] [,6]
[1,]    1    1    1    2    2    3
[2,]    2    3    4    3    4    4
> tcn <- ncol(tc)
> tcn
[1] 6
> #racunanje p vrijednosti pojedinacnih parova sa Bonferroni korekcijom
> p.val.corr <- rep(NA, tcn)
> for(i in 1:tcn) {
+ tc.l <- tc[, i]
+ seg.x <- tc.l[1]
+ seg.y <- tc.l[2]
+ p.val.itt <- wilcox.test(x = db$LGDR[db$segment.e%in%ug[seg.x]], 
+  y = db$LGDR[db$segment.e%in%ug[seg.y]],
+  correct = FALSE, 
+  paired = FALSE)$p.val 
+ p.val.corr[[i]] <- p.val.itt * tcn 
+ }
> names(p.val.corr) <- apply(tc, 2, function(x) paste0(ug[x[1]], " VS ", ug[x[2]]))
> p.val.corr < alpha
segment1 VS segment2 segment1 VS segment3 segment1 VS segment4 segment2 VS segment3 segment2 VS segment4 
                TRUE                 TRUE                 TRUE                 TRUE                 TRUE 
segment3 VS segment4 
                TRUE 
> p.val.corr[p.val.corr < alpha]
segment1 VS segment2 segment1 VS segment3 segment1 VS segment4 segment2 VS segment3 segment2 VS segment4 
        1.089317e-23         4.544252e-23         2.963084e-19         1.118721e-70         9.870027e-18 
segment3 VS segment4 
        2.189997e-17 
> #r funkcija
> pw.wt <- pairwise.wilcox.test(db$LGDR, db$segment.e, p.adjust.method = "bonferroni", correct = FALSE)
> pw.wt

        Pairwise comparisons using Wilcoxon rank sum test 

data:  db$LGDR and db$segment.e 

         segment1 segment2 segment3
segment2 <2e-16   -        -       
segment3 <2e-16   <2e-16   -       
segment4 <2e-16   <2e-16   <2e-16  

P value adjustment method: bonferroni 
> pw.wt$p.val
             segment1     segment2     segment3
segment2 1.089317e-23           NA           NA
segment3 4.544252e-23 1.118721e-70           NA
segment4 2.963084e-19 9.870027e-18 2.189997e-17

Last updated

Was this helpful?