Nieklasyczne metody statystyki

Nieklasyczna estymacja regresji

1 Zadanie 1: Prestiż względem dochodu.

Zestaw danych “Prestige” (z pakietu “car”) zawiera dane nt. prestiżu n=102 Kanadyjskich zawodów z 1971 roku, a także średni dochód w danym zawodzie. Do zbadania zależności między prestiżem a dochodem wykorzystaj metody regresji nieparametrycznej.

Najpierw zwizualizujemy zależnośc pomiędzy prestiżem a dochodem. Widać, że zależnośc nie jest liniowa.

data("Prestige")

plot(Prestige$income, Prestige$prestige, 
     main = "Zależność między dochodem a prestiżem",
     xlab = "Income", 
     ylab = "Prestige", 
     pch = 10, col = "black")

1.0.1 Model loess (lokalnie kwadratowy)

mloess <- loess(prestige ~ income, data=Prestige)
ggplot(Prestige) +
    geom_point(aes(x=income,y=prestige)) +
    ggtitle("Prestige (Loess, span=0.75)") +
    geom_line(aes(x=income, y=fitted(mloess)),
      col='blue')

Parametr span=0.75 wskazuje, że do wygładzenia brana jest pod uwagę relatywnie duża liczba sąsiednich punktów. Dzięki temu krzywa jest bardziej gładka i mniej wrażliwa na szum w danych. Krzywa pokazuje, że prestiż zawodowy ogólnie rośnie wraz ze wzrostem dochodów. Można zauważyć: Początkowo szybki wzrost prestiżu przy wzroście dochodów. Potem tempo wzrostu maleje, co może sugerować efekt nasycenia – wyższe dochody nie wpływają już znacząco na postrzeganie prestiżu. Istnieje wyraźna, choć nieliniowa zależność między dochodem a prestiżem zawodowym.

1.0.2 Geom_smooth

ggplot(Prestige) +
    geom_point(aes(x=income,y=prestige)) +
    geom_smooth(aes(x=income,y=prestige), method='loess',
      span=0.22)

## `geom_smooth()` using formula = 'y ~ x'

Wartość parametru span = 0.22 oznacza, że do wygładzania wykorzystywany jest stosunkowo mały zakres sąsiednich punktów, co pozwala na uchwycenie bardziej szczegółowych nieregularności w danych. Dany parametr pozwala dokładniej zobaczyć lokalne różnice w danych, ale może być mniej odpowiedni, jeśli chcemy uzyskać bardziej ogólny obraz zależności.

Wykres pokazuje, że prestiż zawodowy jest skorelowany z dochodem, ale zależność nie jest liniowa.

Wyraźnie widoczny jest wzrost prestiżu w miarę wzrostu dochodu, jednak dla wyższych dochodów tempo wzrostu wyhamowuje.

1.0.3 Sploty interpolujące

splint <- smooth.spline(
  Prestige$prestige,
  Prestige$income,
  cv=TRUE)

## Warning in smooth.spline(Prestige$prestige, Prestige$income, cv = TRUE):
## krzyżowa walidacja z nieunikalnymi wartościami 'x' wydaje się wątpliwa

splint <- data.frame(x=Prestige$income,y=Prestige$prestige)
ggplot(Prestige) +
  geom_point(aes(x=income,y=prestige)) +
  ggtitle("Sploty interpolujące, lambda wybrana przez CV") +
  geom_line(data=splint, aes(x=x, y=y), col='blue')

Splot interpolujący jest bardziej elastyczny niż proste modele regresji i może lepiej odwzorować złożone zależności w danych. Wartość lambda wybrana przez walidację krzyżową minimalizuje ryzyko nadmiernego dopasowania lub nadmiernego wygładzenia.

Krzywa dobrze odzwierciedla relację dochód-prestiż, szczególnie w zakresie nieliniowym.

2 Zadanie 2: Wypadek samochodowy

Zbiór danych “mcycle” (z pakietu MASS) zawiera n=133 pary punktów czasowych (w ms) i obserwowanych przyspieszeń głowy (w g), które zostały zarejestrowane w symulowanym wypadku motocyklowym.

Najpierw zwizualizujemy zależnośc pomiędzy czasem a przyspieszeniem. Widać, że zależnośc nie jest liniowa.

data("mcycle")

plot(mcycle$times, mcycle$accel, 
     main = "Zależność między czasem a przyspieszeniem",
     xlab = "Times", 
     ylab = "Accel", 
     pch = 10, col = "blue")

2.0.1 Model loess (lokalnie kwadratowy)

mloess1 <- loess(accel ~ times, data=mcycle)
ggplot(mcycle) +
    geom_point(aes(x=times,y=accel)) +
    ggtitle("Prestige (Loess, span=0.75)") +
    geom_line(aes(x=times, y=fitted(mloess1)),
      col='green')

Dzięki umiarkowanemu wygładzeniu krzywa jest płynna i dobrze odwzorowuje ogólny trend danych. Model LOESS z wybranym parametrem span = 0.75 dobrze odwzorowuje ogólną zależność między czasem a przyspieszeniem. Jest wystarczająco gładki, aby uchwycić główny trend, ale może nie oddawać drobniejszych szczegółów (lokalnych zmian w danych).

2.0.2 Sploty interpolujące

splint1 <- smooth.spline(
  mcycle$accel,
  mcycle$times,
  cv=TRUE)

## Warning in smooth.spline(mcycle$accel, mcycle$times, cv = TRUE): krzyżowa
## walidacja z nieunikalnymi wartościami 'x' wydaje się wątpliwa

splint1 <- data.frame(x=mcycle$times,y=mcycle$accel)
ggplot(mcycle) +
  geom_point(aes(x=times,y=accel)) +
  ggtitle("Sploty interpolujące, lambda wybrana przez CV") +
  geom_line(data=splint1, aes(x=x, y=y), col='blue')

Tego rodzaju analiza jest przydatna w przypadku danych dynamicznych, gdzie interesuje nas zarówno ogólny trend, jak i lokalne zmiany w obserwacjach.