Statistika - Zadaća 1

Z1: Analize kategoričkih podataka

1. Ispitivana je incidencija pretilosti u populaciji školske djece. Slučajnim izborom odabran je uzorak učenika i dobiveni su podaci u tablici 1.

Tablica 1 Dječaci Djevojčice
Pretili 195 245
Normale mase 630 610

 

1.1. Procijenite udio pretilih učenika u populaciji školske djece (za sve učenike i prema spolu).

Grafički prikaz s postotnim udjelima (stupičasti):

library(ggplot2)

# Podaci
spol <- c(rep("Dječaci", 2), rep("Djevojčice", 2), rep("Svi učenici", 2))
kategorija <- rep(c("Pretili", "Normalne mase"), 3)
vrijednost <- c(195, 630, 245, 610, 440, 1240)
grupa <- c(rep("Po spolu", 4), rep("Ukupno", 2))

data <- data.frame(spol, kategorija, vrijednost, grupa)

data$spol <- factor(data$spol, levels = c("Dječaci", "Djevojčice", "Svi učenici"))
data$grupa <- factor(data$grupa, levels = c("Po spolu", "Ukupno"))

ggplot(data, aes(fill = kategorija, y = vrijednost, x = spol)) + 
  geom_bar(position = "fill", stat = "identity") +
  scale_y_continuous(labels = scales::percent) +
  scale_fill_manual(values = c("Pretili" = "#E74C3C", "Normalne mase" = "#3498DB")) +
  facet_wrap(~ grupa, scales = "free_x", strip.position = "left") +
  labs(
    title = "Udio pretilih učenika",
    x = NULL,
    y = "Udio (%)",
    fill = "Kategorija"
  ) +
  theme_minimal()

Grafički prikaz s postotnim udjelima (pie chart):

library(ggplot2)
library(gridExtra)

# --- 1.1 Ukupno ---
data_ukupno <- data.frame(
  kategorija = c("Pretili", "Normalne mase"),
  vrijednost = c(440, 1240)
)

p1 <- ggplot(data_ukupno, aes(x = "", y = vrijednost, fill = kategorija)) +
  geom_bar(stat = "identity", width = 1) +
  coord_polar("y") +
  scale_fill_manual(values = c("Pretili" = "#E74C3C", "Normalne mase" = "#3498DB")) +
  labs(title = "Ukupno učenici", fill = "Kategorija") +
  geom_text(aes(label = paste0(round(vrijednost / sum(vrijednost) * 100, 1), "%")),
            position = position_stack(vjust = 0.5), color = "white", size = 5) +
  theme_void() +
  theme(plot.title = element_text(hjust = 0.5, face = "bold"),
         plot.title.position = "plot")

# --- 1.1 Dječaci ---
data_djecaci <- data.frame(
  kategorija = c("Pretili", "Normalne mase"),
  vrijednost = c(195, 630)
)

p2 <- ggplot(data_djecaci, aes(x = "", y = vrijednost, fill = kategorija)) +
  geom_bar(stat = "identity", width = 1) +
  coord_polar("y") +
  scale_fill_manual(values = c("Pretili" = "#E74C3C", "Normalne mase" = "#3498DB")) +
  labs(title = "Dječaci", fill = "Kategorija") +
  geom_text(aes(label = paste0(round(vrijednost / sum(vrijednost) * 100, 1), "%")),
            position = position_stack(vjust = 0.5), color = "white", size = 5) +
  theme_void() +
  theme(plot.title = element_text(hjust = 0.5, face = "bold"),
         plot.title.position = "plot")

# --- 1.1 Djevojčice ---
data_djevojcice <- data.frame(
  kategorija = c("Pretili", "Normalne mase"),
  vrijednost = c(245, 610)
)

p3 <- ggplot(data_djevojcice, aes(x = "", y = vrijednost, fill = kategorija)) +
  geom_bar(stat = "identity", width = 1) +
  coord_polar("y") +
  scale_fill_manual(values = c("Pretili" = "#E74C3C", "Normalne mase" = "#3498DB")) +
  labs(title = "Djevojčice", fill = "Kategorija") +
  geom_text(aes(label = paste0(round(vrijednost / sum(vrijednost) * 100, 1), "%")),
            position = position_stack(vjust = 0.5), color = "white", size = 5) +
  theme_void() +
  theme(plot.title = element_text(hjust = 0.5, face = "bold"),
         plot.title.position = "plot")


# --- Prikaz svih grafova ---
grid.arrange(p1, p2, p3, ncol = 3)

Izračunato koristeći Excel tablicu s Merlina; vidljivo i na grafovima:

  • postotni udio pretilih dječaka: (195/825) x 100 = 0,236 x 100 = 23,6%

  • postotni udio pretilih djevojčica (245/855) x 100 = 0,287 x 100 = 28,7%

  • postotni udio pretilih učenika (440/160) x 100 = 0,262 x 100 = 26,2%


frekv. obiljezja vel. uzorka proporcija granice pouzdanosti
f N p q SD 1,96*SD -95% 95%
DJEČACI 195 825 0,236 0,764 0,015 0,029 0,207 0,265
DJEVOJČICE 245 855 0,287 0,713 0,015 0,030 0,256 0,317
SVI UČENICI 440 1680 0,262 0,738 0,011 0,021 0,241 0,283


  • Sa 95% sigurnošću procjenjujemo 20,7%-26,5% pretilih dječaka (od ukupnog broja dječaka).

  • Sa 95% sigurnošću procjenjujemo 25,6%-31,7% pretilih djevojčica (od ukupnog broja djevojčica).

  • Sa 95% sigurnošću procjenjujemo 24,1%-28,3% pretilih učenika (od ukupnog broja učenika).

1.2. Da li se udio pretilih učenika razlikuje prema spolu?  Riješite zadatak na dva načina i interpretirajte rezultate.

Nul-hipoteza H0: nema razlike u proporcijama u dvije skupine (=nema razlike u udjelima pretilih dječaka i djevojčica)

Alternativna hipoteza H1: postoji razlika u udjelima pretilih dječaka i djevojčica

Tablica 1 Dječaci Djevojčice
Pretili 195 245 440
Normale mase 630 610 1240
825 855 1680
  1. način: test razlike proporcija
# Test razlike proporcija

# x = broj pretilih, n = ukupno po spolu
prop.test(x = c(195, 245), 
          n = c(825, 855),
          correct = FALSE)  # correct=FALSE = bez Yatesove korekcije, isto kao Z-test

    2-sample test for equality of proportions without continuity correction

data:  c(195, 245) out of c(825, 855)
X-squared = 5.4704, df = 1, p-value = 0.01934
alternative hypothesis: two.sided
95 percent confidence interval:
 -0.09212622 -0.00824592
sample estimates:
   prop 1    prop 2 
0.2363636 0.2865497

Rezultati testa:

  • procijenjene proporcije:

    • p₁ = 0,236

    • p₂ = 0,287

  • razlika proporcija: Δp = p₁ − p₂ ≈ −0,050

  • p-vrijednost: 0,019

  • 95% interval pouzdanosti: (−0,092 ; −0,008)

Interpretacija:

  • p = 0,019 < 0,05, odbacujemo H0. Postoji statistički značajna razlika između proporcija u dvije skupine.

  • Budući da je razlika negativna (p₁ < p₂), druga skupina ima veću proporciju.

  • S 95% pouzdanosti, stvarna razlika proporcija nalazi se između −0,092 i −0,008; u populaciji očekujemo da je proporcija u drugoj skupini veća za otprilike 0,8% do 9,2%.

  1. način: hi-kvadrat test
# hi-kvadrat test

# Napravimo kontingencijsku tablicu
tablica_1.2 <- matrix(c(195, 630, 245, 610), 
                      nrow = 2, 
                      dimnames = list(
                        c("Pretili", "Normalne mase"),
                        c("Dječaci", "Djevojčice")
                      ))

tablica_1.2  # provjeri tablicu
              Dječaci Djevojčice
Pretili           195        245
Normalne mase     630        610
chisq.test(tablica_1.2, correct = FALSE)

    Pearson's Chi-squared test

data:  tablica_1.2
X-squared = 5.4704, df = 1, p-value = 0.01934
test <- chisq.test(tablica_1.2, correct = FALSE)

test$expected    # očekivane frekvencije
               Dječaci Djevojčice
Pretili       216.0714   223.9286
Normalne mase 608.9286   631.0714
test$residuals   # standardizirani reziduali 
                 Dječaci Djevojčice
Pretili       -1.4334921  1.4081186
Normalne mase  0.8539075 -0.8387929
test$statistic   # χ² vrijednost
X-squared 
 5.470429 
test$p.value     # p-vrijednost
[1] 0.01934088
# -------------------------------
# VELIČINE EFEKTA
# -------------------------------

N <- sum(tablica_1.2)  # ukupno

# Φ (phi koeficijent)
phi <- sqrt(test$statistic / N)
phi
 X-squared 
0.05706319 
# Koeficijent kontingencije C
C <- sqrt(test$statistic / (test$statistic + N))
C
 X-squared 
0.05697051

Interpretacija:

  • p = 0,019 < 0,05, odbacujemo H0. Postoji statistički značajna razlika između proporcija u dvije skupine.

  • Koeficijent kontigencije (C) i Φ koeficijent pokazuju da je povezanost spola i pretilosti slaba (mali efekt).

Zaključak:

S oba testa dobiven je p=0,01934 (u 1,9% jednakih studija možemo očekivati suprotan zaključak).

p < 0,05. Odbacujemo H0. Udio pretilih učenika statistički se značajno razlikuje prema spolu.

Oba pristupa daju isti zaključak, što potvrđuje robusnost rezultata.

1.3. Nastavljeno je praćenje učenika koji nisu pretili (630 dječaka i 610 djevojčica) kroz naredno razdoblje od godine dana. Kod djevojčica je zabilježen razvoj pretilosti u 110 slučajeva, a kod dječaka u 95. Postoji li razlika u riziku razvoja pretilosti u ovoj razvojnoj fazi s obzirom na spol? Interpretirajte rezultate.

H₀: Ne postoji razlika u riziku razvoja pretilosti u ovoj razvojnoj fazi s obzirom na spol.

H₁: Postoji razlika u riziku razvoja pretilosti u ovoj razvojnoj fazi s obzirom na spol.

Razvili pretilost Nisu razvili Ukupno
Dječaci 95 535 630
Djevojčice 110 500 610 
# "Ručni" izračun 

R_djecaci <- 95 / 630
R_djevojcice <- 110 / 610

RR <- R_djevojcice / R_djecaci

SE_log_RR <- sqrt((1 - R_djevojcice) / 110 + (1 - R_djecaci) / 95)
lower <- exp(log(RR) - 1.96 * SE_log_RR)
upper <- exp(log(RR) + 1.96 * SE_log_RR)

cat("RR =", round(RR, 3), "\n")
RR = 1.196 
cat("95% CI: (", round(lower, 3), "-", round(upper, 3), ")\n")
95% CI: ( 0.93 - 1.537 )
library(epitools)

# Kontingencijska tablica
# VAŽNO: riskratio() očekuje redoslijed - ishod u recima, eksponiranost u stupcima
# Redak 1 = "bolest" (razvili pretilost), Redak 2 = "bez bolesti"
# Stupac 1 = referentna grupa (dječaci), Stupac 2 = usporedna grupa (djevojčice)

tablica_1.3 <- matrix(c(95, 110, 535, 500), 
                      nrow = 2, 
                      dimnames = list(
                        c("Dječaci", "Djevojčice"),
                        c("Razvili pretilost", "Nisu razvili")
                      ))

riskratio(tablica_1.3, method = "wald", rev = "columns")
$data
           Nisu razvili Razvili pretilost Total
Dječaci             535                95   630
Djevojčice          500               110   610
Total              1035               205  1240

$measure
                        NA
risk ratio with 95% C.I. estimate     lower    upper
              Dječaci    1.000000        NA       NA
              Djevojčice 1.195858 0.9304737 1.536935

$p.value
            NA
two-sided    midp.exact fisher.exact chi.square
  Dječaci            NA           NA         NA
  Djevojčice  0.1628033    0.1692328  0.1616134

$correction
[1] FALSE

attr(,"method")
[1] "Unconditional MLE & normal approximation (Wald) CI"

RR = 1.196 (usporedna grupa = djevojčice imaju 1,2× veći rizik razvoja pretilosti od referentne grupe = dječaci)

95% CI: ( 0.934 - 1.530 ) (interval pouzdanosti uključuje 1 → razlika nije statistički značajna)

Zaključak:

Ne odbacujemo H0 - ne postoji razlika u riziku razvoja pretilosti u ovoj razvojnoj fazi s obzirom na spol.

2. Skupina od 200 sportaša savladava testove opterećenja s ocjenom “zadovoljio/la” ili “nije zaodovljio/la”. Savladavaju prvo jedan, a potom drugi test. Dobiveni su rezultati prikazani su tablicom 2.

Tablica 2 2.test
zadovoljili nisu zadovoljili
1.test zadovoljili 110 10
nisu zadovoljili 30 50

2.1. Možete li ocijeniti razlikuju li se testovi opterećenja u težini njihovog savladavanja?

H0: nema razlike u opterećenju u težini savladavanja testova

H1: postoji razlika u opterećenju u težini savladavanja testova

2. test: zadovoljili 2. test: nisu Ukupno
1. test: zadovoljili 110 (a) 10 (b) 120
1. test: nisu 30 (c) 50 (d) 80
Ukupno 140 60 200

McNemarov test:

# McNemarov test
tablica_2.1 <- matrix(c(110, 30, 10, 50),
                      nrow = 2,
                      dimnames = list(
                        c("1.test: zadovoljili", "1.test: nisu zadovoljili"),
                        c("2.test: zadovoljili", "2.test: nisu zadovoljili")
                      ))

tablica_2.1  # provjeri tablicu
                         2.test: zadovoljili 2.test: nisu zadovoljili
1.test: zadovoljili                      110                       10
1.test: nisu zadovoljili                  30                       50
mcnemar.test(tablica_2.1)

    McNemar's Chi-squared test with continuity correction

data:  tablica_2.1
McNemar's chi-squared = 9.025, df = 1, p-value = 0.002663

p=0,002663 < 0,05. Odbacujemo H0. Testovi opterećenja razlikuju se u težini njihovog savladavanja.

2.2. Sportaši su potom podijeljeni (slučajnim izborom) u dvije skupine po 100. Novi test (3. Test) proveden je nakon što je u jednoj skupini uveden režim posebnog treninga i prehrane. Dobiveni su podaci u tablici 3. Da li je uvođenje režima posebnog treninga i prehrane povezano s rezultatom testiranja? Kolike su šanse da se ovakvim režimom treninga i prehrane postigne zadovoljavajući rezultat na testovima opterećenja?

Tablica 3
  1. test
zadovoljili nisu zadovoljili
Uz posebni trening i prehranu 84 16
Bez posebnog treninga i prehrane 62 38

H0: nema povezanosti uvođenja režima posebnog treninga i prehrane s rezultatom testiranja

H1: postoji povezanost uvođenja režima posebnog treninga i prehrane s rezultatom testiranja

Zadovoljili Nisu zadovoljili Ukupno
Posebni trening 84 (a) 16 (b) 100
Bez treninga 62 (c) 38 (d) 100
Ukupno 146 54 200 
tablica_2.2 <- matrix(c(84, 62, 16, 38),
                      nrow = 2,
                      dimnames = list(
                        c("Uz trening", "Bez treninga"),
                        c("Zadovoljili", "Nisu zadovoljili")
                      ))

tablica_2.2
             Zadovoljili Nisu zadovoljili
Uz trening            84               16
Bez treninga          62               38
# Hi-kvadrat test
chisq.test(tablica_2.2, correct = FALSE)

    Pearson's Chi-squared test

data:  tablica_2.2
X-squared = 12.278, df = 1, p-value = 0.0004583
# Odds Ratio
library(epitools)
oddsratio(tablica_2.2, method = "wald")
$data
             Zadovoljili Nisu zadovoljili Total
Uz trening            84               16   100
Bez treninga          62               38   100
Total                146               54   200

$measure
                        NA
odds ratio with 95% C.I. estimate    lower    upper
            Uz trening   1.000000       NA       NA
            Bez treninga 3.217742 1.646579 6.288104

$p.value
              NA
two-sided       midp.exact fisher.exact   chi.square
  Uz trening            NA           NA           NA
  Bez treninga 0.000473631 0.0007360849 0.0004583216

$correction
[1] FALSE

attr(,"method")
[1] "Unconditional MLE & normal approximation (Wald) CI"

p=0,0004583 < 0,05. Odbacujemo H0. Postoji povezanost uvođenja režima posebnog treninga i prehrane s rezultatom testiranja.

OR = 3.218, 95% CI: (1.636 - 6.331)

OR = 3,218 → sportaši uz posebni trening imaju 3,2× veće šanse za zadovoljavajući rezultat u odnosu na skupinu bez posebnog treninga

  • 95% CI (1,636 — 6,331) ne uključuje 1 → OR je statistički značajan