Zadanie 1

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 załaduj dane i zwizualizuj relację pomiędzy dochodem (X) a prestiżem (Y).

data("Prestige")
ggplot(Prestige)+
  geom_point(aes(x=income, y=prestige))

Związek między dochodem a prestiżem jest nieliniowy. Dla zawodów, których zarobki są poniżej 10 tys. dolarów, widać wyraźną, dodatnią liniową zależność między dochodem a prestiżem. Natomiast dla zawodów, które zarabiają od 10 do 25 tys. dolarów, ta zależność staje się mniej wyraźna i nachylenie jest słabsze.

1. Kernel smoothing

fit <- locpoly(x = Prestige$prestige, y = Prestige$income, degree = 0, bandwidth = 1, gridsize = 10000)
fit <- tibble(x = fit$x, y = fit$y)

fit2 <- locpoly(x = Prestige$prestige, y = Prestige$income, degree = 0, bandwidth = 5)
fit2 <- tibble(x = fit2$x, y = fit2$y)

ggplot(data = Prestige, aes(x = prestige, y = income)) +
  geom_point() +
  geom_line(data = fit, aes(x = x, y = y), col = 'red') +
  geom_line(data = fit2, aes(x = x, y = y), col = 'blue') +
  ggtitle("Kernel smoothing - szerokość pasma 1 vs 5")

Czerwona linia, pokazująca szerokość pasma 4, wydaje się zbyt dopasowana do danych, co może wskazywać na overfitting. Z kolei niebieska linia, z ustawioną szerokością pasma równą 4, wydaje się lepiej oddawać rzeczywisty trend.

2. Loess - wielomian lokalnie kwadratowy (dagree=2)

fit3 <- loess(income ~ prestige, span=0.25, degree=2,
  family="gaussian", Prestige)
fit4 <- loess(income ~ prestige, span=0.75, degree=2,
  family="gaussian", Prestige)

ggplot(Prestige) +
  geom_point(aes(x=prestige,y=income)) +
  geom_line(aes(x=prestige, y=fitted(fit3)), col='purple')+
  geom_line(aes(x=prestige, y=fitted(fit4)), col='orange')+
  ggtitle("Loess 0.25 vs 0.75")

Na przedstawionym wykresie pomarańczowa linia, która reprezentuje szerokość pasma na poziomie 0.75, wydaje się być zbyt mocno wygładzona. To wygładzenie jest szczególnie widoczne w obszarze, gdzie wartość “prestige” przekracza 65, ponieważ linia nie jest w stanie uchwycić rozbieżności między obserwacjami, które są od siebie znacznie oddzielone. W wyniku tego, dochody przedstawione za tą linią obejmują zakres od około 18 tysięcy dolarów do zaledwie 5 tysięcy dolarów, co wskazuje na to, że linia nie oddaje dokładnie rzeczywistej zmienności dochodów w tym przedziale.

Loess z przedziałem ufności

ggplot(Prestige) +
    geom_point(aes(x=prestige,y=income)) +
    geom_smooth(aes(x=prestige,y=income), method='loess',
      span=0.25)
## `geom_smooth()` using formula = 'y ~ x'

3. Sploty interpolujące

fit5 <- smooth.spline(Prestige$income, Prestige$prestige, cv=TRUE)
## Warning in smooth.spline(Prestige$income, Prestige$prestige, cv = TRUE):
## krzyżowa walidacja z nieunikalnymi wartościami 'x' wydaje się wątpliwa
fit5 <- data.frame(x=fit5$x,y=fit5$y)
ggplot(Prestige) +
  geom_point(aes(x=income,y=prestige)) +
  ggtitle("Sploty interpolujące, lambda wybrana przez CV") +
  geom_line(data=fit5, aes(x=x, y=y), col='purple')

4. Sploty naturalne

fit6 <- lm(income ~ ns(prestige, df=6), Prestige)
fit7 <- lm(income ~ ns(prestige, df=12), Prestige)

ggplot(Prestige) +
    geom_point(aes(x=prestige,y=income)) +
    ggtitle("Naturalne sploty, 6 vs 12 df") +
    geom_line(aes(x=prestige, y=fitted(fit6)), col='blue')+
    geom_line(aes(x=prestige, y=fitted(fit7)), col='yellow')

Żółta linia, przy stopniu swobody równym 12, lepiej uchwyca szczegóły zawarte w danych, co sprawia, że jest bardziej precyzyjna w odwzorowywaniu ich struktury. Niemniej jednak, jej większa elastyczność może prowadzić do ryzyka nadmiernego dopasowania do przypadkowych fluktuacji, czyli szumu, obecnego w danych. Tego rodzaju dopasowanie może sprawić, że model będzie zbyt skomplikowany i mniej generalizowalny, co może obniżyć jego skuteczność w przewidywaniu nowych, nieznanych danych.

Splotu naturalne z przedziałem ufności

ggplot(Prestige) +
    geom_point(aes(x=income,y=prestige)) +
    geom_smooth(aes(x=income,y=prestige), method='gam',
      formula = y ~ s(x,k=12))

Zadania 2 - wypadek motocyklowy

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.

Do zbadania zależności między czasem a przyspieszeniem wykorzystaj metody regresji nieparametrycznej.

Najpierw wczytaj dane i zwizualizuj zależność między czasem (X) a przyspieszeniem (Y).

library(MASS)
## 
## Dołączanie pakietu: 'MASS'
## Następujący obiekt został zakryty z 'package:dplyr':
## 
##     select
data("mcycle")

ggplot(mcycle)+
  geom_point(aes(x=times,y=accel))

1. Kernel smoothing

fit <- locpoly(mcycle$times, mcycle$accel,
               degree=0, bandwidth=1, gridsize= 10000) %>% as.tibble
## Warning: `as.tibble()` was deprecated in tibble 2.0.0.
## ℹ Please use `as_tibble()` instead.
## ℹ The signature and semantics have changed, see `?as_tibble`.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.
fit2 <- locpoly(mcycle$times, mcycle$accel,         
                degree=0, bandwidth=5) %>% as.tibble

ggplot(mcycle) +
  geom_point(aes(x=times, y=accel)) +
  geom_line(data=fit, aes(x=x, y=y), col='blue')+ 
  geom_line(data=fit2, aes(x=x, y=y), col='green')+ 
  ggtitle("Kernel smoothing - szerokość pasma 1 vs 4")

Niebieska linia, reprezentująca szerokość pasma równą 4, dobrze odzwierciedla charakterystyczne cechy danych, w tym dołek i pik, w których zmiany są szczególnie wyraźne. W tych punktach linia skutecznie uchwyca trendy w danych. Jednak po przekroczeniu wartości times=30, wyniki zaczynają odbiegać od oczekiwanego układu, a linia regresji staje się zbyt szczegółowa. W efekcie, reaguje na pojedyncze obserwacje w sposób nadmiernie wrażliwy, co może prowadzić do niepotrzebnego uwzględnienia fluktuacji, które nie są reprezentatywne dla ogólnych wzorców w danych. To może sprawić, że model będzie mniej stabilny i bardziej podatny na wpływ losowych zmienności.

2. Loess - wielomian lokalnie kwadratowy (degree=2)

fit3 <- loess(accel ~ times, span=0.2, degree=2,   family="gaussian", mcycle)
fit4 <- loess(accel ~ times, span=0.75, degree=2,   family="gaussian", mcycle)

ggplot(mcycle) +
  geom_point(aes(x=times, y=accel)) +
  geom_line(aes(x=times, y=fitted(fit3)), col='violet')+ 
  geom_line(aes(x=times, y=fitted(fit4)), col='darkblue')+ 
  ggtitle("Loess 0.25 vs 0.75")

Na przedstawionym wykresie, niebieska linia, która odpowiada szerokości pasma ustawionej na poziomie 0.75, wydaje się być zbyt mocno wygładzona, przez co nie wiernie odwzorowuje rzeczywisty kształt relacji między zmiennymi. Tego rodzaju wygładzenie powoduje, że linia nie uchwyca szczegółowych zmian w danych, przez co traci istotne informacje o ich rzeczywistej strukturze. Z kolei, przy ustawieniu parametru span na 0.75, linia staje się zbyt czuła na pojedyncze obserwacje, co prowadzi do nadmiernego dopasowania do fluktuacji, które są bardziej wynikiem szumu niż rzeczywistych trendów w danych.

Loess z przedziałem ufności

ggplot(mcycle) +
    geom_point(aes(x=times, y=accel)) +
    geom_smooth(aes(x=times, y=accel), method='loess', span=0.25)
## `geom_smooth()` using formula = 'y ~ x'

Biorąc pod uwagę przedział ufności przy span=0.25, widać, że większość obserwacji znajduje się w jego granicach. Jak dotąd, wydaje się to być najlepsza metoda dopasowania do danych.

3. Sploty interpolujące

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

ggplot(mcycle) +
  geom_point(aes(x=times, y=accel)) +
  ggtitle("Sploty interpolujące, lambda wybrana przez CV") +
  geom_line(data=fit5, aes(x=x, y=y), col='pink')

4. Sploty naturalne

fit6 <- lm(accel ~ ns(times, df=6), mcycle)
fit7 <- lm(accel ~ ns(times, df=12), mcycle)

ggplot(mcycle) +
    geom_point(aes(x=times, y=accel)) +
    ggtitle("Naturalne sploty, 6 vs 12 df") +
    geom_line(aes(x=times, y=fitted(fit6)), col='yellow')+ 
    geom_line(aes(x=times, y=fitted(fit7)), col='blue')

Niebieska linia skuteczniej uchwyca szczegóły w danych, wychwytując zarówno nagłe wzrosty i spadki, jak i płaskie fragmenty w układających się na wykresie obserwacjach.

Sploty naturalne z przedziałem ufności

ggplot(mcycle) +
    geom_point(aes(x=times, y=accel)) +
    geom_smooth(aes(x=times, y=accel), method='gam', formula = y ~ s(x, k=12))

Wykres skutecznie ilustruje zmiany w zależnościach między zmiennymi oraz pokazuje poziom niepewności, który występuje w danych. W szczególności, obszary, w których przedział ufności jest szeroki (takie jak na krańcach wykresu), zwracają uwagę na potencjalne problemy z dokładnością przewidywań. W takich miejscach, zmienność danych jest większa, co może sugerować, że wyniki w tych zakresach mogą być mniej wiarygodne i wymagają większej ostrożności przy ich interpretacji. Warto więc zachować czujność, szczególnie przy analizie danych w tych rejonach wykresu, ponieważ mogą one nie w pełni odzwierciedlać rzeczywiste relacje między zmiennymi.