Zadanie 1.

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

## mapping: x = ~Income, y = ~Prestiż 
## geom_smooth: se = TRUE, na.rm = FALSE, orientation = NA
## stat_smooth: method = NULL, formula = NULL, se = TRUE, n = 80, fullrange = FALSE, level = 0.95, na.rm = FALSE, orientation = NA, method.args = list(), span = 0.75
## position_identity

Prestiż względem dochodu - zależności metodą regresji nieparametrycznej

Na kolejnych wykresach przedstawiono zależności metodami:

1. kwadratów lokalnych (loess)

2. sploty interpolujące

3. sploty naturalne

4. Wygładzanie dwuwymiarowe (dochody ~ prestiż + edukacja)/ (dochody ~ prestiż+płeć)

WIelomian kwadratowy lokalny

## Warning: Using `size` aesthetic for lines was deprecated in ggplot2 3.4.0.
## ℹ Please use `linewidth` instead.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.

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

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

Sploty interpolujące

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

Sploty naturalne

Widzimy, że zwiększając stopnie swobody wykres staje się mniej wygładzony.Jeśli spojrzymy na linie fioletową (df=20) oraz różową (df=13), dostrzegamy duże zagęszczenie zmienności dla dochodów w przedziale 1tys - 10 tys. Dla dochodów >10tys. wykres estymacji jest bardziej wygładzony, co też dosyć dobrze ozwierciedla częstotliwość rozkładu obu zmiennych.

Z reguły chcemy uzyskać dosyć dobrze dopasowaną i wygładzoną estymacje, co w poniższym przykładzie uzyskaliśmy metodą splotów naturalnych i dla stopni swobody df=6. Natomiast należy zwrócić uwagę, że dla wyższych stopni swobody (np/ 13, 20) uzykujemy bardziej dokładną estymacje, która odzwierciedla dokładniej zmienność.

fit3 <- lm(prestige ~ ns(income, df=3), Prestige)
fit6 <- lm(prestige ~ ns(income, df=6), Prestige)
fit13 <- lm(prestige ~ ns(income, df=13), Prestige)
fit20 <- lm(prestige ~ ns(income, df=20), Prestige)

ggplot(Prestige) +
    geom_point(aes(x=income,y=prestige)) +
    ggtitle("Prestiż względem dochodu (sploty naturalne, 3df, 6df, 13df, 20df)") +
    geom_line(aes(x=income, y=fitted(fit20)), col='purple',size = 1.05)+
    geom_line(aes(x=income, y=fitted(fit6)), col='green',size = 1.1)+
    geom_line(aes(x=income, y=fitted(fit3)), col='red',size = 1)+
    geom_line(aes(x=income, y=fitted(fit13)), col='pink',size = 1.1)

Sploty i smooth() - GAM - Uogólniony model addytywny ze zintegrowaną oceną gładkości

ggplot(Prestige) +
    geom_point(aes(x=income,y=prestige)) +
  ggtitle("Prestiż względem dochodu (model GAM)")+
    geom_smooth(aes(x=income,y=prestige), method='gam', formula = y ~ s(x,k=12), col="purple", soze=1.1)

## Warning in geom_smooth(aes(x = income, y = prestige), method = "gam", formula =
## y ~ : Ignoring unknown parameters: `soze`

Wygładzanie dwuwymiarowe

Wnioski

Trudno jednoznaczenie wyznaczyć jedną najlpeszą metodę regresji nieparametrycznej, gdyż sugerujac się jedynie oceną wzrokową wykresów, wyniki są względnie podobne.

Na powyższych wykres dla badanych zależności pomiędzy prestiżem, a dochodem najtrudniejszym elementem był dobór stopni swobony oraz szerokość pasma dla poszczególnych metod. Są to kluczowe parametry, które pozwalają w ławtwy sposób “manipulować” wygładzeniem estymacji, jednakże ich dobranie wymaga doświadczenia i wiedzy analityka.

Zadanie 2.

Wygładzania kernella (KernSmooth)

fit <- locpoly(mcycle$times, mcycle$accel,
        degree=0, bandwidth=0.5) %>% 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.

ggplot(mcycle) +
  geom_point(aes(x=times,y=accel)) +
  ggtitle("Przspieszenie względem czasu - wygładzenie Kernella") +
  geom_line(data=fit, aes(x=x,y=y), col='green')

Kwadraty lokalne (Loess dla róznych pasm szerokości)

Widzimy, że lepiej dopasowana zależność została uzyskana na drugim wykresie - pasmo szerokości (span) = 0.35

smr1 <- loess(accel ~ times, data=mcycle)
ggplot(mcycle) +
    geom_point(aes(x=times,y=accel)) +
    ggtitle("Przspieszenie względem czasu (metoda Loess, span=0.75)") +
    geom_line(aes(x=times, y=fitted(smr1)), col='red')

ggplot(mcycle) +
    geom_point(aes(x=times,y=accel)) +
    ggtitle("Zależność przyspieszenie~czas metodą Loess (szerokość pasma 0.35)") +
    geom_smooth(aes(x=times,y=accel), method='loess',
      span=0.35, col="red")

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

Sploty interpolujące

smr <- 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=smr$x, y=smr$y)
ggplot(mcycle) +
  geom_point(aes(x=times,y=accel)) +
  ggtitle("Przyspieszenie względem czasu (Sploty interpolujące, lambda wybrana przez CV)") +
  geom_line(data=smr, aes(x=x, y=y), col='blue', size=1.4)

Sploty naturalne

Na poniższych wykresach dla metody splotów naturalnych dostrzegamy jak istotny jest dobór stopni swobody do estymacji. Na poniższym przykładzie widzimy, że dla małej liczby stopni swobody zależności zostały słabo odzwierciedlone - wykresy są zbyt spłaszczone. Natomiast dla wykresu czerwonego (df=13) oraz różowego (df=20), zmienność zosstała lepiej oddana, przez co estymacja wydaje się być dokładniejsza.

fit3 <- lm(accel ~ ns(times, df=3), mcycle)
fit6 <- lm(accel ~ ns(times, df=6), mcycle)
fit13 <- lm(accel ~ ns(times, df=13), mcycle)
fit20 <- lm(accel ~ ns(times, df=20), mcycle)

ggplot(mcycle) +
    geom_point(aes(x=times,y=accel)) +
    ggtitle("Przyspieszenie względem czasu (sploty naturalne, 3 df, 6 df, 13 df, 20 df)") +
    geom_line(aes(x=times, y=fitted(fit20)), col='purple',size = 1.1)+
    geom_line(aes(x=times, y=fitted(fit6)), col='green',size = 1.1)+
    geom_line(aes(x=times, y=fitted(fit3)), col='red',size = 1)+
    geom_line(aes(x=times, y=fitted(fit13)), col='pink',size = 1.1)