Zadanie 1

Dane “Prestige” dotyczą prestiżu Kanadysjkich zawodów z 1971r. oraz średni dochód w danym zawodzie. Dane zostaną wykorzystane do przeprowadzeniaregresji nieparametrycznej.

###Biblioteka Do wykonania zadań potrzebujemy poniżej porzedstawionej biblioteki

library(car)
library(KernSmooth)
library(tidyverse)
library(MASS)
library(ggplot2)
library(splines)
data("Prestige")
attach(Prestige)
data("mcycle")

Wykres ukazujący relacje między dochodem, a prestiżem

Związek wygląda na nieliniowy. Dla zawodów, które zarabiają mniej niż $10K, istnieje silna (pozytywna) liniowa zależność pomiędzy dochodem a prestiżem. Jednak w przypadku zawodów, które zarabiają od 10 do 25 tysięcy dolarów, związek ten ma znacznie inne (osłabione) nachylenie.

ggplot(Prestige) +
  geom_point(aes(x=income,y=prestige))+  
  labs(title = "Relacja między dochodem, a prestiżem zawodu")

Estymacja nieliniowej zależności między prestiżem a dochodem

Lokalna regresja wielomianowa, gdzie dregree=0 i bandwith=5

fit1 <- locpoly(x = Prestige$prestige, y = Prestige$income, degree = 0, bandwidth = 5) %>% 
  as_tibble()

ggplot(Prestige, aes(x = prestige, y = income)) +
  geom_point() +
  geom_line(data = fit1, aes(x = x, y = y), color = 'green') +
  labs(title = "Nieliniowa estymacja zależności między dochodem, a prestiżem",
       x = "Prestiż",
       y = "Dochód")

Zmiana stopnia pasma

Lokalna regresja wielomianowa, gdzie dregree=3 i bandwith=5 oraz dregree=10 i bandwith=5

Stopień wielomianu również wpływa na charakter estymacji. Przy niższym stopniu (np. 0) model jest prostszy i lepiej nadaje się do danych o stosunkowo prostej, monotonicznej zależności. Z kolei wyższe stopnie (np. 3 czy 10) pozwalają na bardziej elastyczne dopasowanie, ale mogą prowadzić do nadmiernego dopasowania, szczególnie przy bardziej złożonych danych. Wysoki stopień wielomianu może wprowadzić artefakty, które są niezgodne z rzeczywistymi trendami w danych.

fit2 <- locpoly(x = Prestige$prestige, y = Prestige$income, degree = 3, bandwidth = 5) %>% 
  as_tibble()

ggplot(Prestige, aes(x = prestige, y = income)) +
  geom_point() +
  geom_line(data = fit2, aes(x = x, y = y), color = 'green') +
  labs(title = "Nieliniowa estymacja zależności między dochodem, a prestiżem",
       x = "Prestiż",
       y = "Dochód")

fit3 <- locpoly(x = Prestige$prestige, y = Prestige$income, degree = 10, bandwidth = 5) %>% 
  as_tibble()

ggplot(Prestige, aes(x = prestige, y = income)) +
  geom_point() +
  geom_line(data = fit3, aes(x = x, y = y), color = 'green') +
  labs(title = "Nieliniowa estymacja zależności między dochodem, a prestiżem",
       x = "Prestiż",
       y = "Dochód")

Zmiana szerokości pasma

Lokalna regresja wielomianowa, gdzie dregree=0 i bandwith=10, oraz gdzie dregree=0 i bandwith=1

Zmiana szerokości pasma ma znaczący wpływ na gładkość estymacji funkcji regresji. Przy mniejszej szerokości (np. 1), regresja dokładniej odwzorowuje lokalne fluktuacje w danych, co może jednak prowadzić do nadmiernego dopasowania i szumu w wynikach. Przy większej szerokości pasma (np. 10), funkcja regresji jest gładsza, co pozwala na bardziej uogólniony obraz zależności, ale może utracić szczegóły lokalnych zmian.

fit4 <- locpoly(x = Prestige$prestige, y = Prestige$income, degree = 0, bandwidth = 10) %>% 
  as_tibble()

ggplot(Prestige, aes(x = prestige, y = income)) +
  geom_point() +
  geom_line(data = fit4, aes(x = x, y = y), color = 'green') +
  labs(title = "Nieliniowa estymacja zależności między dochodem, a prestiżem",
       x = "Prestiż",
       y = "Dochód")

fit5 <- locpoly(x = Prestige$prestige, y = Prestige$income, degree = 0, bandwidth = 1) %>% 
  as_tibble()

ggplot(Prestige, aes(x = prestige, y = income)) +
  geom_point() +
  geom_line(data = fit5, aes(x = x, y = y), color = 'green') +
  labs(title = "Nieliniowa estymacja zależności między dochodem, a prestiżem",
       x = "Prestiż",
       y = "Dochód")

Wnioski

Optymalny dobór szerokości pasma i stopnia wielomianu zależy od charakteru danych. Dla danych z nieliniowym, ale względnie stabilnym związkiem, umiarkowana szerokość pasma (np. 5) i niższy stopień wielomianu (np. 0 lub 1) wydają się najlepsze, gdyż umożliwiają dobrą estymację bez nadmiernego dopasowania.

Interpolacja splotów

Interpolacja splotów jest metodą dopasowania wygładzonej krzywej do danych, pozwalającą na uzyskanie ciągłej i gładkiej funkcji przechodzącej przez punkty danych. Wykorzystanie funkcji smooth.spline z opcją walidacji krzyżowej (cv=TRUE) dobiera optymalny poziom wygładzenia, tak aby uniknąć nadmiernego dopasowania, jednocześnie zachowując ogólną strukturę danych.

W przypadku danych o prestiżu kanadyjskich zawodów z 1971 r. interpolacja splotów pokazuje nieliniową, wygładzoną zależność między prestiżem a dochodem. Ta metoda pozwala na lepsze odwzorowanie trendu dla wartości pośrednich, co jest szczególnie pomocne przy analizie nieliniowych relacji w zmiennych społeczno-ekonomicznych.

is <-smooth.spline(prestige, income, cv=TRUE) 
## Warning in smooth.spline(prestige, income, cv = TRUE): krzyżowa walidacja z
## nieunikalnymi wartościami 'x' wydaje się wątpliwa
smr <- data.frame(x=is$x,y=is$y)
ggplot(Prestige) +
  geom_point(aes(x=prestige,y=income)) +
  geom_line(data=smr, aes(x=x,y=y), col='green')+
  labs(title = "Sploty interpolujące",
       x = "Prestiż",
       y = "Dochód")

Sploty naturalne

Sploty naturalne to specjalny rodzaj splotów, które są liniowe poza zakresem danych, co zmniejsza ryzyko nadmiernego dopasowania na końcach przedziału. W przykładzie zastosowano naturalne sploty o 12 stopniach swobody (df=12), co pozwala na elastyczne dopasowanie funkcji do danych bez wpływu na wartości skrajne.

Sploty naturalne lepiej radzą sobie z dopasowaniem trendów na końcach zakresu danych, co w przypadku danych o dochodzie i prestiżu zawodowym pozwala na uchwycenie zmienności zależności między tymi zmiennymi, bez nadmiernego wyginania krzywej na końcach. Dzięki temu metoda ta jest odpowiednia do analizy danych społeczno-ekonomicznych, gdzie skrajne wartości mogą mieć mniejszą zmienność w stosunku do trendu ogólnego.

sn <- lm(prestige ~ ns(income, df=12), Prestige)
ggplot(Prestige) +
    geom_point(aes(x=income,y=prestige)) +
    ggtitle("Prestiż względem  dochodu (Naturalne sploty, 12 df)") +
    geom_line(aes(x=income, y=fitted(sn)), col='green')

Zadanie 2

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.

ggplot(mcycle, aes(x = times, y = accel)) +
  geom_point()  +
  labs(title = "Relacja między czasem, a przyspieszeniem",
       x = "Czas (ms)",
       y = "Przyspieszenie (g)")

Estymacja nieliniowej zależności

W zadaniu przeprowadzono estymację nieliniowej zależności między czasem a przyspieszeniem głowy w symulowanym wypadku motocyklowym. Użyto trzech modeli o różnych stopniach wielomianów i szerokości okien (bandwidth) w funkcji locpoly.

Pierwszy model, z drugim stopniem wielomianu i szerokością okna 7, zapewnił wygładzenie danych i oddał ogólny trend zależności, ale był zbyt prosty, by uchwycić lokalne fluktuacje w danych.

fit6 <- locpoly(mcycle$times, mcycle$accel, degree = 2, bandwidth = 7) %>% as_tibble()

ggplot(mcycle, aes(x = times, y = accel)) +
  geom_point() +
  geom_line(data = fit6, aes(x = x, y = y), color = 'green') +
  labs(title = "Nieliniowa estymacja zależności między czasem a przyspieszeniem",
       x = "Czas (ms)",
       y = "Przyspieszenie (g)")

Drugi model, z trzecim stopniem wielomianu i szerokością okna 5, lepiej odzwierciedlił lokalne zmiany przyspieszenia, oferując bardziej dynamiczną krzywą dopasowaną do danych.

fit7 <- locpoly(mcycle$times, mcycle$accel, degree = 3, bandwidth = 5) %>% as_tibble()

ggplot(mcycle, aes(x = times, y = accel)) +
  geom_point() +
  geom_line(data = fit7, aes(x = x, y = y), color = 'green') +
  labs(title = "Estymacja z wyższym stopniem wielomianu (stopień 3)",
       x = "Czas (ms)",
       y = "Przyspieszenie (g)")

Ostatni model, o dziesiątym stopniu wielomianu i tej samej szerokości okna 5, dopasował się zbyt szczegółowo, oddając drobne fluktuacje jako istotne i stając się niestabilny, co jest przykładem nadmiernego dopasowania (overfitting).

fit8 <- locpoly(mcycle$times, mcycle$accel, degree = 10, bandwidth = 5) %>% as_tibble()

ggplot(mcycle, aes(x = times, y = accel)) +
  geom_point() +
  geom_line(data = fit8, aes(x = x, y = y), color = 'green') +
  labs(title = "Estymacja z wyższym stopniem wielomianu (stopień 10)",
       x = "Czas (ms)",
       y = "Przyspieszenie (g)")

Wnioski

Podsumowując, najlepsze dopasowanie uzyskano w modelu o stopniu 3 z szerokością okna 5, gdyż zapewniał on równowagę między precyzją a stabilnością estymacji, odzwierciedlając rzeczywiste lokalne zmiany przyspieszenia bez nadmiernego dopasowania.

Interpolacja splotów

Interpolacja splotów pozwala na gładkie dopasowanie krzywej do danych, co daje lepsze odwzorowanie nieliniowej zależności.

is2 <- 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
smr <- data.frame(x=is2$x, y=is2$y)

ggplot(mcycle) +
  geom_point(aes(x=times, y=accel)) +
  geom_line(data=smr, aes(x=x, y=y), color='green') +
  labs(title = "Sploty interpolujące",
       x = "Czas (ms)",
       y = "Przyspieszenie (g)")

Sploty naturalne

W przypadku splotów naturalnych stosujemy 12 stopni swobody (df=12), co pozwala na elastyczne dopasowanie funkcji bez nadmiernego wyginania na końcach.

sn2 <- lm(accel ~ ns(times, df=12), mcycle)
ggplot(mcycle) +
  geom_point(aes(x=times, y=accel)) +
  geom_line(aes(x=times, y=fitted(sn2)), color='green') +
  labs(title = "Przyspieszenie względem czasu (Naturalne sploty, 12 df)",
       x = "Czas (ms)",
       y = "Przyspieszenie (g)")

wnioski

Podsumowując, najlepszy model uzyskano dla trzeciego stopnia wielomianu o szerokości okna 5, ponieważ zachowuje równowagę między dokładnym odwzorowaniem lokalnych zmian przyspieszenia a stabilnością estymacji, unikając nadmiernego dopasowania. Z kolei interpolacja i sploty naturalne okazały się przydatne do odwzorowania bardziej płynnych i realistycznych zależności nieliniowych.